-- |
-- 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) = forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SignedExact Certificate]
l

getCertificateChainLeaf :: CertificateChain -> SignedExact Certificate
getCertificateChainLeaf :: CertificateChain -> SignedExact Certificate
getCertificateChainLeaf (CertificateChain [])    = 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]
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
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]
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
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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FailedReason]
l   = CertificateRejectReason -> CertificateUsage
CertificateUsageReject   CertificateRejectReason
CertificateRejectExpired
    | FailedReason
InFuture forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FailedReason]
l  = CertificateRejectReason -> CertificateUsage
CertificateUsageReject   CertificateRejectReason
CertificateRejectExpired
    | FailedReason
UnknownCA forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FailedReason]
l = CertificateRejectReason -> CertificateUsage
CertificateUsageReject   CertificateRejectReason
CertificateRejectUnknownCA
    | FailedReason
SelfSigned forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FailedReason]
l = CertificateRejectReason -> CertificateUsage
CertificateUsageReject  CertificateRejectReason
CertificateRejectUnknownCA
    | FailedReason
EmptyChain forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FailedReason]
l = CertificateRejectReason -> CertificateUsage
CertificateUsageReject  CertificateRejectReason
CertificateRejectAbsent
    | Bool
otherwise          = CertificateRejectReason -> CertificateUsage
CertificateUsageReject forall a b. (a -> b) -> a -> b
$ [Char] -> CertificateRejectReason
CertificateRejectOther (forall a. Show a => a -> [Char]
show [FailedReason]
l)

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