-- |
-- Module      : Data.X509.CRL
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- Read and Write X509 Certificate Revocation List (CRL).
--
-- follows RFC5280 / RFC6818.
--
{-# LANGUAGE FlexibleContexts #-}

module Data.X509.CRL
    ( CRL(..)
    , RevokedCertificate(..)
    ) where

import Control.Applicative

import Data.Hourglass (DateTime)
import Data.ASN1.Types

import Data.X509.DistinguishedName
import Data.X509.AlgorithmIdentifier
import Data.X509.ExtensionRaw
import Data.X509.Internal

-- | Describe a Certificate revocation list
data CRL = CRL
    { crlVersion             :: Integer
    , crlSignatureAlg        :: SignatureALG
    , crlIssuer              :: DistinguishedName
    , crlThisUpdate          :: DateTime
    , crlNextUpdate          :: Maybe DateTime
    , crlRevokedCertificates :: [RevokedCertificate]
    , crlExtensions          :: Extensions
    } deriving (Show,Eq)

-- | Describe a revoked certificate identifiable by serial number.
data RevokedCertificate = RevokedCertificate
    { revokedSerialNumber :: Integer
    , revokedDate         :: DateTime
    , revokedExtensions   :: Extensions
    } deriving (Show,Eq)

instance ASN1Object CRL where
    toASN1 crl = encodeCRL crl
    fromASN1 = runParseASN1State parseCRL

-- TODO support extension
instance ASN1Object RevokedCertificate where
    fromASN1 (Start Sequence : IntVal serial : ASN1Time _ t _ : End Sequence : xs) =
        Right (RevokedCertificate serial t (Extensions Nothing), xs)
    fromASN1 l = Left ("fromASN1: X509.RevokedCertificate: unknown format:" ++ show l)
    toASN1 (RevokedCertificate serial time _) = \xs ->
        Start Sequence : IntVal serial : ASN1Time TimeGeneralized time Nothing : End Sequence : xs

parseCRL :: ParseASN1 CRL
parseCRL = do
    CRL <$> (getNext >>= getVersion)
        <*> getObject
        <*> getObject
        <*> (getNext >>= getThisUpdate)
        <*> getNextUpdate
        <*> getRevokedCertificates
        <*> getObject
  where getVersion (IntVal v) = return $ fromIntegral v
        getVersion _          = throwError "unexpected type for version"

        getThisUpdate (ASN1Time _ t1 _) = return t1
        getThisUpdate _                 = throwError "bad this update format, expecting time"

        getNextUpdate = getNextMaybe timeOrNothing

        timeOrNothing (ASN1Time _ tnext _) = Just tnext
        timeOrNothing _                    = Nothing

        getRevokedCertificates = onNextContainer Sequence $ getMany getObject

encodeCRL :: CRL -> ASN1S
encodeCRL crl xs =
    [IntVal $ crlVersion crl] ++
    toASN1 (crlSignatureAlg crl) [] ++
    toASN1 (crlIssuer crl) [] ++
    [ASN1Time TimeGeneralized (crlThisUpdate crl) Nothing] ++
    (maybe [] (\t -> [ASN1Time TimeGeneralized t Nothing]) (crlNextUpdate crl)) ++
    [Start Sequence] ++
    revoked ++
    [End Sequence] ++
    toASN1 (crlExtensions crl) [] ++
    xs
  where
    revoked = concatMap (\e -> toASN1 e []) (crlRevokedCertificates crl)