-- |
-- Module      : Network.TLS.X509
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- 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.Validation
import Data.X509.CertificateStore

isNullCertificateChain :: CertificateChain -> Bool
isNullCertificateChain :: CertificateChain -> Bool
isNullCertificateChain (CertificateChain [SignedExact Certificate]
l) = [SignedExact Certificate] -> 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
showList :: [CertificateRejectReason] -> ShowS
$cshowList :: [CertificateRejectReason] -> ShowS
show :: CertificateRejectReason -> [Char]
$cshow :: CertificateRejectReason -> [Char]
showsPrec :: Int -> CertificateRejectReason -> ShowS
$cshowsPrec :: Int -> CertificateRejectReason -> ShowS
Show,CertificateRejectReason -> CertificateRejectReason -> Bool
(CertificateRejectReason -> CertificateRejectReason -> Bool)
-> (CertificateRejectReason -> CertificateRejectReason -> Bool)
-> Eq CertificateRejectReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CertificateRejectReason -> CertificateRejectReason -> Bool
$c/= :: CertificateRejectReason -> CertificateRejectReason -> Bool
== :: CertificateRejectReason -> CertificateRejectReason -> Bool
$c== :: CertificateRejectReason -> CertificateRejectReason -> Bool
Eq)

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

wrapCertificateChecks :: [FailedReason] -> CertificateUsage
wrapCertificateChecks :: [FailedReason] -> CertificateUsage
wrapCertificateChecks [] = CertificateUsage
CertificateUsageAccept
wrapCertificateChecks [FailedReason]
l
    | FailedReason
Expired FailedReason -> [FailedReason] -> 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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FailedReason]
l  = CertificateRejectReason -> CertificateUsage
CertificateUsageReject   CertificateRejectReason
CertificateRejectExpired
    | FailedReason
UnknownCA FailedReason -> [FailedReason] -> 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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FailedReason]
l = CertificateRejectReason -> CertificateUsage
CertificateUsageReject  CertificateRejectReason
CertificateRejectUnknownCA
    | FailedReason
EmptyChain FailedReason -> [FailedReason] -> 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