-- | X509 helpers
module Network.TLS.X509 (
    CertificateChain (..),
    Certificate (..),
    SignedCertificate,
    getCertificate,
    isNullCertificateChain,
    getCertificateChainLeaf,
    CertificateRejectReason (..),
    CertificateUsage (..),
    CertificateStore,
    ValidationCache,
    exceptionValidationCache,
    validateDefault,
    FailedReason,
    ServiceID,
    wrapCertificateChecks,
    pubkeyType,
) where

import Data.X509
import Data.X509.CertificateStore
import Data.X509.Validation

isNullCertificateChain :: CertificateChain -> Bool
isNullCertificateChain :: CertificateChain -> Bool
isNullCertificateChain (CertificateChain [SignedExact Certificate]
l) = [SignedExact Certificate] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SignedExact Certificate]
l

getCertificateChainLeaf :: CertificateChain -> SignedExact Certificate
getCertificateChainLeaf :: CertificateChain -> SignedExact Certificate
getCertificateChainLeaf (CertificateChain []) = [Char] -> SignedExact Certificate
forall a. HasCallStack => [Char] -> a
error [Char]
"empty certificate chain"
getCertificateChainLeaf (CertificateChain (SignedExact Certificate
x : [SignedExact Certificate]
_)) = SignedExact Certificate
x

-- | Certificate and Chain rejection reason
data CertificateRejectReason
    = CertificateRejectExpired
    | CertificateRejectRevoked
    | CertificateRejectUnknownCA
    | CertificateRejectAbsent
    | CertificateRejectOther String
    deriving (Int -> CertificateRejectReason -> ShowS
[CertificateRejectReason] -> ShowS
CertificateRejectReason -> [Char]
(Int -> CertificateRejectReason -> ShowS)
-> (CertificateRejectReason -> [Char])
-> ([CertificateRejectReason] -> ShowS)
-> Show CertificateRejectReason
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CertificateRejectReason -> ShowS
showsPrec :: Int -> CertificateRejectReason -> ShowS
$cshow :: CertificateRejectReason -> [Char]
show :: CertificateRejectReason -> [Char]
$cshowList :: [CertificateRejectReason] -> ShowS
showList :: [CertificateRejectReason] -> ShowS
Show, CertificateRejectReason -> CertificateRejectReason -> Bool
(CertificateRejectReason -> CertificateRejectReason -> Bool)
-> (CertificateRejectReason -> CertificateRejectReason -> Bool)
-> Eq CertificateRejectReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CertificateRejectReason -> CertificateRejectReason -> Bool
== :: CertificateRejectReason -> CertificateRejectReason -> Bool
$c/= :: CertificateRejectReason -> CertificateRejectReason -> Bool
/= :: CertificateRejectReason -> CertificateRejectReason -> Bool
Eq)

-- | Certificate Usage callback possible returns values.
data CertificateUsage
    = -- | usage of certificate accepted
      CertificateUsageAccept
    | -- | usage of certificate rejected
      CertificateUsageReject CertificateRejectReason
    deriving (Int -> CertificateUsage -> ShowS
[CertificateUsage] -> ShowS
CertificateUsage -> [Char]
(Int -> CertificateUsage -> ShowS)
-> (CertificateUsage -> [Char])
-> ([CertificateUsage] -> ShowS)
-> Show CertificateUsage
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CertificateUsage -> ShowS
showsPrec :: Int -> CertificateUsage -> ShowS
$cshow :: CertificateUsage -> [Char]
show :: CertificateUsage -> [Char]
$cshowList :: [CertificateUsage] -> ShowS
showList :: [CertificateUsage] -> ShowS
Show, CertificateUsage -> CertificateUsage -> Bool
(CertificateUsage -> CertificateUsage -> Bool)
-> (CertificateUsage -> CertificateUsage -> Bool)
-> Eq CertificateUsage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CertificateUsage -> CertificateUsage -> Bool
== :: CertificateUsage -> CertificateUsage -> Bool
$c/= :: CertificateUsage -> CertificateUsage -> Bool
/= :: CertificateUsage -> CertificateUsage -> Bool
Eq)

wrapCertificateChecks :: [FailedReason] -> CertificateUsage
wrapCertificateChecks :: [FailedReason] -> CertificateUsage
wrapCertificateChecks [] = CertificateUsage
CertificateUsageAccept
wrapCertificateChecks [FailedReason]
l
    | FailedReason
Expired FailedReason -> [FailedReason] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FailedReason]
l = CertificateRejectReason -> CertificateUsage
CertificateUsageReject CertificateRejectReason
CertificateRejectExpired
    | FailedReason
InFuture FailedReason -> [FailedReason] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FailedReason]
l = CertificateRejectReason -> CertificateUsage
CertificateUsageReject CertificateRejectReason
CertificateRejectExpired
    | FailedReason
UnknownCA FailedReason -> [FailedReason] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FailedReason]
l = CertificateRejectReason -> CertificateUsage
CertificateUsageReject CertificateRejectReason
CertificateRejectUnknownCA
    | FailedReason
SelfSigned FailedReason -> [FailedReason] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FailedReason]
l = CertificateRejectReason -> CertificateUsage
CertificateUsageReject CertificateRejectReason
CertificateRejectUnknownCA
    | FailedReason
EmptyChain FailedReason -> [FailedReason] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FailedReason]
l = CertificateRejectReason -> CertificateUsage
CertificateUsageReject CertificateRejectReason
CertificateRejectAbsent
    | Bool
otherwise = CertificateRejectReason -> CertificateUsage
CertificateUsageReject (CertificateRejectReason -> CertificateUsage)
-> CertificateRejectReason -> CertificateUsage
forall a b. (a -> b) -> a -> b
$ [Char] -> CertificateRejectReason
CertificateRejectOther ([FailedReason] -> [Char]
forall a. Show a => a -> [Char]
show [FailedReason]
l)

pubkeyType :: PubKey -> String
pubkeyType :: PubKey -> [Char]
pubkeyType = PubKeyALG -> [Char]
forall a. Show a => a -> [Char]
show (PubKeyALG -> [Char]) -> (PubKey -> PubKeyALG) -> PubKey -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKey -> PubKeyALG
pubkeyToAlg