    -- |
    -- 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, TimezoneOffset(..))
    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
        { CRL -> Integer
    crlVersion             :: Integer
        , CRL -> SignatureALG
    crlSignatureAlg        :: SignatureALG
        , CRL -> DistinguishedName
    crlIssuer              :: DistinguishedName
        , CRL -> DateTime
    crlThisUpdate          :: DateTime
        , CRL -> Maybe DateTime
    crlNextUpdate          :: Maybe DateTime
        , CRL -> [RevokedCertificate]
    crlRevokedCertificates :: [RevokedCertificate]
        , CRL -> Extensions
    crlExtensions          :: Extensions
        } deriving (Int -> CRL -> ShowS
    [CRL] -> ShowS
    CRL -> String
    (Int -> CRL -> ShowS)
    -> (CRL -> String) -> ([CRL] -> ShowS) -> Show CRL
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [CRL] -> ShowS
    $cshowList :: [CRL] -> ShowS
    show :: CRL -> String
    $cshow :: CRL -> String
    showsPrec :: Int -> CRL -> ShowS
    $cshowsPrec :: Int -> CRL -> ShowS
    Show,CRL -> CRL -> Bool
    (CRL -> CRL -> Bool) -> (CRL -> CRL -> Bool) -> Eq CRL
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: CRL -> CRL -> Bool
    $c/= :: CRL -> CRL -> Bool
    == :: CRL -> CRL -> Bool
    $c== :: CRL -> CRL -> Bool
    Eq)

    -- | Describe a revoked certificate identifiable by serial number.
    data RevokedCertificate = RevokedCertificate
        { RevokedCertificate -> Integer
    revokedSerialNumber :: Integer
        , RevokedCertificate -> DateTime
    revokedDate         :: DateTime
        , RevokedCertificate -> Extensions
    revokedExtensions   :: Extensions
        } deriving (Int -> RevokedCertificate -> ShowS
    [RevokedCertificate] -> ShowS
    RevokedCertificate -> String
    (Int -> RevokedCertificate -> ShowS)
    -> (RevokedCertificate -> String)
    -> ([RevokedCertificate] -> ShowS)
    -> Show RevokedCertificate
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [RevokedCertificate] -> ShowS
    $cshowList :: [RevokedCertificate] -> ShowS
    show :: RevokedCertificate -> String
    $cshow :: RevokedCertificate -> String
    showsPrec :: Int -> RevokedCertificate -> ShowS
    $cshowsPrec :: Int -> RevokedCertificate -> ShowS
    Show,RevokedCertificate -> RevokedCertificate -> Bool
    (RevokedCertificate -> RevokedCertificate -> Bool)
    -> (RevokedCertificate -> RevokedCertificate -> Bool)
    -> Eq RevokedCertificate
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: RevokedCertificate -> RevokedCertificate -> Bool
    $c/= :: RevokedCertificate -> RevokedCertificate -> Bool
    == :: RevokedCertificate -> RevokedCertificate -> Bool
    $c== :: RevokedCertificate -> RevokedCertificate -> Bool
    Eq)

    instance ASN1Object CRL where
        toASN1 :: CRL -> ASN1S
    toASN1 crl :: CRL
    crl = CRL -> ASN1S
    encodeCRL CRL
    crl
        fromASN1 :: [ASN1] -> Either String (CRL, [ASN1])
    fromASN1 = ParseASN1 CRL -> [ASN1] -> Either String (CRL, [ASN1])
    forall a. ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
    runParseASN1State ParseASN1 CRL
    parseCRL

    -- TODO support extension
    instance ASN1Object RevokedCertificate where
        fromASN1 :: [ASN1] -> Either String (RevokedCertificate, [ASN1])
    fromASN1 (Start Sequence : IntVal serial :: Integer
    serial : ASN1Time _ t :: DateTime
    t _ : End Sequence : xs :: [ASN1]
    xs) =
            (RevokedCertificate, [ASN1])
    -> Either String (RevokedCertificate, [ASN1])
    forall a b. b -> Either a b
    Right (Integer -> DateTime -> Extensions -> RevokedCertificate
    RevokedCertificate Integer
    serial DateTime
    t (Maybe [ExtensionRaw] -> Extensions
    Extensions Maybe [ExtensionRaw]
    forall a. Maybe a
    Nothing), [ASN1]
    xs)
        fromASN1 l :: [ASN1]
    l = String -> Either String (RevokedCertificate, [ASN1])
    forall a b. a -> Either a b
    Left ("fromASN1: X509.RevokedCertificate: unknown format:" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [ASN1] -> String
    forall a. Show a => a -> String
    show [ASN1]
    l)
        toASN1 :: RevokedCertificate -> ASN1S
    toASN1 (RevokedCertificate serial :: Integer
    serial time :: DateTime
    time _) = \xs :: [ASN1]
    xs ->
            ASN1ConstructionType -> ASN1
    Start ASN1ConstructionType
    Sequence ASN1 -> ASN1S
    forall a. a -> [a] -> [a]
    : Integer -> ASN1
    IntVal Integer
    serial ASN1 -> ASN1S
    forall a. a -> [a] -> [a]
    : ASN1TimeType -> DateTime -> Maybe TimezoneOffset -> ASN1
    ASN1Time ASN1TimeType
    TimeGeneralized DateTime
    time (TimezoneOffset -> Maybe TimezoneOffset
    forall a. a -> Maybe a
    Just (Int -> TimezoneOffset
    TimezoneOffset 0)) ASN1 -> ASN1S
    forall a. a -> [a] -> [a]
    : ASN1ConstructionType -> ASN1
    End ASN1ConstructionType
    Sequence ASN1 -> ASN1S
    forall a. a -> [a] -> [a]
    : [ASN1]
    xs

    parseCRL :: ParseASN1 CRL
    parseCRL :: ParseASN1 CRL
    parseCRL = do
        Integer
    -> SignatureALG
    -> DistinguishedName
    -> DateTime
    -> Maybe DateTime
    -> [RevokedCertificate]
    -> Extensions
    -> CRL
    CRL (Integer
     -> SignatureALG
     -> DistinguishedName
     -> DateTime
     -> Maybe DateTime
     -> [RevokedCertificate]
     -> Extensions
     -> CRL)
    -> ParseASN1 Integer
    -> ParseASN1
         (SignatureALG
          -> DistinguishedName
          -> DateTime
          -> Maybe DateTime
          -> [RevokedCertificate]
          -> Extensions
          -> CRL)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ParseASN1 ASN1
    getNext ParseASN1 ASN1 -> (ASN1 -> ParseASN1 Integer) -> ParseASN1 Integer
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ASN1 -> ParseASN1 Integer
    forall a. Num a => ASN1 -> ParseASN1 a
    getVersion)
            ParseASN1
      (SignatureALG
       -> DistinguishedName
       -> DateTime
       -> Maybe DateTime
       -> [RevokedCertificate]
       -> Extensions
       -> CRL)
    -> ParseASN1 SignatureALG
    -> ParseASN1
         (DistinguishedName
          -> DateTime
          -> Maybe DateTime
          -> [RevokedCertificate]
          -> Extensions
          -> CRL)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ParseASN1 SignatureALG
    forall a. ASN1Object a => ParseASN1 a
    getObject
            ParseASN1
      (DistinguishedName
       -> DateTime
       -> Maybe DateTime
       -> [RevokedCertificate]
       -> Extensions
       -> CRL)
    -> ParseASN1 DistinguishedName
    -> ParseASN1
         (DateTime
          -> Maybe DateTime -> [RevokedCertificate] -> Extensions -> CRL)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ParseASN1 DistinguishedName
    forall a. ASN1Object a => ParseASN1 a
    getObject
            ParseASN1
      (DateTime
       -> Maybe DateTime -> [RevokedCertificate] -> Extensions -> CRL)
    -> ParseASN1 DateTime
    -> ParseASN1
         (Maybe DateTime -> [RevokedCertificate] -> Extensions -> CRL)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (ParseASN1 ASN1
    getNext ParseASN1 ASN1
    -> (ASN1 -> ParseASN1 DateTime) -> ParseASN1 DateTime
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ASN1 -> ParseASN1 DateTime
    getThisUpdate)
            ParseASN1
      (Maybe DateTime -> [RevokedCertificate] -> Extensions -> CRL)
    -> ParseASN1 (Maybe DateTime)
    -> ParseASN1 ([RevokedCertificate] -> Extensions -> CRL)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ParseASN1 (Maybe DateTime)
    getNextUpdate
            ParseASN1 ([RevokedCertificate] -> Extensions -> CRL)
    -> ParseASN1 [RevokedCertificate] -> ParseASN1 (Extensions -> CRL)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ParseASN1 [RevokedCertificate]
    getRevokedCertificates
            ParseASN1 (Extensions -> CRL)
    -> ParseASN1 Extensions -> ParseASN1 CRL
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ParseASN1 Extensions
    forall a. ASN1Object a => ParseASN1 a
    getObject
      where getVersion :: ASN1 -> ParseASN1 a
    getVersion (IntVal v :: Integer
    v) = a -> ParseASN1 a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> ParseASN1 a) -> a -> ParseASN1 a
    forall a b. (a -> b) -> a -> b
    $ Integer -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    v
            getVersion _          = String -> ParseASN1 a
    forall a. String -> ParseASN1 a
    throwParseError "unexpected type for version"

            getThisUpdate :: ASN1 -> ParseASN1 DateTime
    getThisUpdate (ASN1Time _ t1 :: DateTime
    t1 _) = DateTime -> ParseASN1 DateTime
    forall (m :: * -> *) a. Monad m => a -> m a
    return DateTime
    t1
            getThisUpdate _                 = String -> ParseASN1 DateTime
    forall a. String -> ParseASN1 a
    throwParseError "bad this update format, expecting time"

            getNextUpdate :: ParseASN1 (Maybe DateTime)
    getNextUpdate = (ASN1 -> Maybe DateTime) -> ParseASN1 (Maybe DateTime)
    forall a. (ASN1 -> Maybe a) -> ParseASN1 (Maybe a)
    getNextMaybe ASN1 -> Maybe DateTime
    timeOrNothing

            timeOrNothing :: ASN1 -> Maybe DateTime
    timeOrNothing (ASN1Time _ tnext :: DateTime
    tnext _) = DateTime -> Maybe DateTime
    forall a. a -> Maybe a
    Just DateTime
    tnext
            timeOrNothing _                    = Maybe DateTime
    forall a. Maybe a
    Nothing

            getRevokedCertificates :: ParseASN1 [RevokedCertificate]
    getRevokedCertificates = ASN1ConstructionType
    -> ParseASN1 [RevokedCertificate] -> ParseASN1 [RevokedCertificate]
    forall a. ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a
    onNextContainer ASN1ConstructionType
    Sequence (ParseASN1 [RevokedCertificate] -> ParseASN1 [RevokedCertificate])
    -> ParseASN1 [RevokedCertificate] -> ParseASN1 [RevokedCertificate]
    forall a b. (a -> b) -> a -> b
    $ ParseASN1 RevokedCertificate -> ParseASN1 [RevokedCertificate]
    forall a. ParseASN1 a -> ParseASN1 [a]
    getMany ParseASN1 RevokedCertificate
    forall a. ASN1Object a => ParseASN1 a
    getObject

    encodeCRL :: CRL -> ASN1S
    encodeCRL :: CRL -> ASN1S
    encodeCRL crl :: CRL
    crl xs :: [ASN1]
    xs =
        [Integer -> ASN1
    IntVal (Integer -> ASN1) -> Integer -> ASN1
    forall a b. (a -> b) -> a -> b
    $ CRL -> Integer
    crlVersion CRL
    crl] [ASN1] -> ASN1S
    forall a. [a] -> [a] -> [a]
    ++
        SignatureALG -> ASN1S
    forall a. ASN1Object a => a -> ASN1S
    toASN1 (CRL -> SignatureALG
    crlSignatureAlg CRL
    crl) [] [ASN1] -> ASN1S
    forall a. [a] -> [a] -> [a]
    ++
        DistinguishedName -> ASN1S
    forall a. ASN1Object a => a -> ASN1S
    toASN1 (CRL -> DistinguishedName
    crlIssuer CRL
    crl) [] [ASN1] -> ASN1S
    forall a. [a] -> [a] -> [a]
    ++
        [ASN1TimeType -> DateTime -> Maybe TimezoneOffset -> ASN1
    ASN1Time ASN1TimeType
    TimeGeneralized (CRL -> DateTime
    crlThisUpdate CRL
    crl) (TimezoneOffset -> Maybe TimezoneOffset
    forall a. a -> Maybe a
    Just (Int -> TimezoneOffset
    TimezoneOffset 0))] [ASN1] -> ASN1S
    forall a. [a] -> [a] -> [a]
    ++
        ([ASN1] -> (DateTime -> [ASN1]) -> Maybe DateTime -> [ASN1]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] (\t :: DateTime
    t -> [ASN1TimeType -> DateTime -> Maybe TimezoneOffset -> ASN1
    ASN1Time ASN1TimeType
    TimeGeneralized DateTime
    t (TimezoneOffset -> Maybe TimezoneOffset
    forall a. a -> Maybe a
    Just (Int -> TimezoneOffset
    TimezoneOffset 0))]) (CRL -> Maybe DateTime
    crlNextUpdate CRL
    crl)) [ASN1] -> ASN1S
    forall a. [a] -> [a] -> [a]
    ++
        [ASN1ConstructionType -> ASN1
    Start ASN1ConstructionType
    Sequence] [ASN1] -> ASN1S
    forall a. [a] -> [a] -> [a]
    ++
        [ASN1]
    revoked [ASN1] -> ASN1S
    forall a. [a] -> [a] -> [a]
    ++
        [ASN1ConstructionType -> ASN1
    End ASN1ConstructionType
    Sequence] [ASN1] -> ASN1S
    forall a. [a] -> [a] -> [a]
    ++
        Extensions -> ASN1S
    forall a. ASN1Object a => a -> ASN1S
    toASN1 (CRL -> Extensions
    crlExtensions CRL
    crl) [] [ASN1] -> ASN1S
    forall a. [a] -> [a] -> [a]
    ++
        [ASN1]
    xs
      where
        revoked :: [ASN1]
    revoked = (RevokedCertificate -> [ASN1]) -> [RevokedCertificate] -> [ASN1]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (\e :: RevokedCertificate
    e -> RevokedCertificate -> ASN1S
    forall a. ASN1Object a => a -> ASN1S
    toASN1 RevokedCertificate
    e []) (CRL -> [RevokedCertificate]
    crlRevokedCertificates CRL
    crl)