{-# LANGUAGE PatternSynonyms, ViewPatterns, RecordWildCards #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.X509.AIA
-- Copyright   :  (c) Alexey Radkov 2024
-- License     :  BSD-style
--
-- Maintainer  :  alexey.radkov@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Encode and decode X509 Authority Information Access extension.
--
-- This module complies with /rfc5280/.
-----------------------------------------------------------------------------

module Data.X509.AIA (AuthorityInfoAccess (..)
                     ,AIAMethod (..)
                     ,ExtAuthorityInfoAccess (..)
                     ) where

import Data.X509
import Data.ASN1.Types
import Data.ASN1.Stream
import Data.ByteString (ByteString)

pattern OidAIA :: [Integer]
pattern $mOidAIA :: forall {r}. [Integer] -> ((# #) -> r) -> ((# #) -> r) -> r
$bOidAIA :: [Integer]
OidAIA = [1, 3, 6, 1, 5, 5, 7, 1, 1]

pattern OidOCSP :: [Integer]
pattern $mOidOCSP :: forall {r}. [Integer] -> ((# #) -> r) -> ((# #) -> r) -> r
$bOidOCSP :: [Integer]
OidOCSP = [1, 3, 6, 1, 5, 5, 7, 48, 1]

pattern OidCAIssuers :: [Integer]
pattern $mOidCAIssuers :: forall {r}. [Integer] -> ((# #) -> r) -> ((# #) -> r) -> r
$bOidCAIssuers :: [Integer]
OidCAIssuers = [1, 3, 6, 1, 5, 5, 7, 48, 2]

-- | Authority Info Access description.
--
-- The fields correspond to /accessMethod/ and /accessLocation/ as defined in
-- /rfc5280/.
data AuthorityInfoAccess = AuthorityInfoAccess { AuthorityInfoAccess -> AIAMethod
aiaMethod :: AIAMethod
                                               , AuthorityInfoAccess -> ByteString
aiaLocation :: ByteString
                                               } deriving (Int -> AuthorityInfoAccess -> ShowS
[AuthorityInfoAccess] -> ShowS
AuthorityInfoAccess -> String
(Int -> AuthorityInfoAccess -> ShowS)
-> (AuthorityInfoAccess -> String)
-> ([AuthorityInfoAccess] -> ShowS)
-> Show AuthorityInfoAccess
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthorityInfoAccess -> ShowS
showsPrec :: Int -> AuthorityInfoAccess -> ShowS
$cshow :: AuthorityInfoAccess -> String
show :: AuthorityInfoAccess -> String
$cshowList :: [AuthorityInfoAccess] -> ShowS
showList :: [AuthorityInfoAccess] -> ShowS
Show, AuthorityInfoAccess -> AuthorityInfoAccess -> Bool
(AuthorityInfoAccess -> AuthorityInfoAccess -> Bool)
-> (AuthorityInfoAccess -> AuthorityInfoAccess -> Bool)
-> Eq AuthorityInfoAccess
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthorityInfoAccess -> AuthorityInfoAccess -> Bool
== :: AuthorityInfoAccess -> AuthorityInfoAccess -> Bool
$c/= :: AuthorityInfoAccess -> AuthorityInfoAccess -> Bool
/= :: AuthorityInfoAccess -> AuthorityInfoAccess -> Bool
Eq)

-- | Method of Authority Info Access (/OCSP/ or /CA issuers/).
data AIAMethod = OCSP | CAIssuers deriving (Int -> AIAMethod -> ShowS
[AIAMethod] -> ShowS
AIAMethod -> String
(Int -> AIAMethod -> ShowS)
-> (AIAMethod -> String)
-> ([AIAMethod] -> ShowS)
-> Show AIAMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AIAMethod -> ShowS
showsPrec :: Int -> AIAMethod -> ShowS
$cshow :: AIAMethod -> String
show :: AIAMethod -> String
$cshowList :: [AIAMethod] -> ShowS
showList :: [AIAMethod] -> ShowS
Show, AIAMethod -> AIAMethod -> Bool
(AIAMethod -> AIAMethod -> Bool)
-> (AIAMethod -> AIAMethod -> Bool) -> Eq AIAMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AIAMethod -> AIAMethod -> Bool
== :: AIAMethod -> AIAMethod -> Bool
$c/= :: AIAMethod -> AIAMethod -> Bool
/= :: AIAMethod -> AIAMethod -> Bool
Eq)

instance OIDable AIAMethod where
    getObjectID :: AIAMethod -> [Integer]
getObjectID AIAMethod
OCSP = [Integer]
OidOCSP
    getObjectID AIAMethod
CAIssuers = [Integer]
OidCAIssuers

instance OIDNameable AIAMethod where
    fromObjectID :: [Integer] -> Maybe AIAMethod
fromObjectID [Integer]
OidOCSP = AIAMethod -> Maybe AIAMethod
forall a. a -> Maybe a
Just AIAMethod
OCSP
    fromObjectID [Integer]
OidCAIssuers = AIAMethod -> Maybe AIAMethod
forall a. a -> Maybe a
Just AIAMethod
CAIssuers
    fromObjectID [Integer]
_ = Maybe AIAMethod
forall a. Maybe a
Nothing

-- | Authority Info Access extension.
--
-- Notable limitations of the 'Extension' instance:
--
-- - encoding of access method /CA Issuers/ is not implemented, trying to
--   encode this will throw an error,
-- - data with a non-string-like access location (e.g. /directoryName/) get
--   skipped while decoding.
newtype ExtAuthorityInfoAccess = ExtAuthorityInfoAccess [AuthorityInfoAccess]
    deriving (Int -> ExtAuthorityInfoAccess -> ShowS
[ExtAuthorityInfoAccess] -> ShowS
ExtAuthorityInfoAccess -> String
(Int -> ExtAuthorityInfoAccess -> ShowS)
-> (ExtAuthorityInfoAccess -> String)
-> ([ExtAuthorityInfoAccess] -> ShowS)
-> Show ExtAuthorityInfoAccess
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtAuthorityInfoAccess -> ShowS
showsPrec :: Int -> ExtAuthorityInfoAccess -> ShowS
$cshow :: ExtAuthorityInfoAccess -> String
show :: ExtAuthorityInfoAccess -> String
$cshowList :: [ExtAuthorityInfoAccess] -> ShowS
showList :: [ExtAuthorityInfoAccess] -> ShowS
Show, ExtAuthorityInfoAccess -> ExtAuthorityInfoAccess -> Bool
(ExtAuthorityInfoAccess -> ExtAuthorityInfoAccess -> Bool)
-> (ExtAuthorityInfoAccess -> ExtAuthorityInfoAccess -> Bool)
-> Eq ExtAuthorityInfoAccess
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExtAuthorityInfoAccess -> ExtAuthorityInfoAccess -> Bool
== :: ExtAuthorityInfoAccess -> ExtAuthorityInfoAccess -> Bool
$c/= :: ExtAuthorityInfoAccess -> ExtAuthorityInfoAccess -> Bool
/= :: ExtAuthorityInfoAccess -> ExtAuthorityInfoAccess -> Bool
Eq)

data DecState = DecStart | DecMethod | DecLocation OID | DecEnd

instance Extension ExtAuthorityInfoAccess where
    extOID :: ExtAuthorityInfoAccess -> [Integer]
extOID = [Integer] -> ExtAuthorityInfoAccess -> [Integer]
forall a b. a -> b -> a
const [Integer]
OidAIA
    extHasNestedASN1 :: Proxy ExtAuthorityInfoAccess -> Bool
extHasNestedASN1 = Bool -> Proxy ExtAuthorityInfoAccess -> Bool
forall a b. a -> b -> a
const Bool
True
    extEncode :: ExtAuthorityInfoAccess -> [ASN1]
extEncode (ExtAuthorityInfoAccess [AuthorityInfoAccess]
aia) =
        ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
        ASN1 -> [ASN1] -> [ASN1]
forall a. a -> [a] -> [a]
: (AuthorityInfoAccess -> [ASN1]) -> [AuthorityInfoAccess] -> [ASN1]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\AuthorityInfoAccess {ByteString
AIAMethod
aiaMethod :: AuthorityInfoAccess -> AIAMethod
aiaLocation :: AuthorityInfoAccess -> ByteString
aiaMethod :: AIAMethod
aiaLocation :: ByteString
..} ->
                        case AIAMethod
aiaMethod of
                            AIAMethod
OCSP ->
                                [ ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
                                , [Integer] -> ASN1
OID ([Integer] -> ASN1) -> [Integer] -> ASN1
forall a b. (a -> b) -> a -> b
$ AIAMethod -> [Integer]
forall a. OIDable a => a -> [Integer]
getObjectID AIAMethod
aiaMethod
                                , ASN1Class -> Int -> ByteString -> ASN1
Other ASN1Class
Context Int
6 ByteString
aiaLocation
                                , ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence
                                ]
                            AIAMethod
CAIssuers ->
                                String -> [ASN1]
forall a. HasCallStack => String -> a
error String
"encoding CA Issuers is not implemented"
                    ) [AuthorityInfoAccess]
aia
        [ASN1] -> [ASN1] -> [ASN1]
forall a. [a] -> [a] -> [a]
++ [ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence]
    extDecode :: [ASN1] -> Either String ExtAuthorityInfoAccess
extDecode [Start ASN1ConstructionType
Sequence, End ASN1ConstructionType
Sequence] =
        ExtAuthorityInfoAccess -> Either String ExtAuthorityInfoAccess
forall a b. b -> Either a b
Right (ExtAuthorityInfoAccess -> Either String ExtAuthorityInfoAccess)
-> ExtAuthorityInfoAccess -> Either String ExtAuthorityInfoAccess
forall a b. (a -> b) -> a -> b
$ [AuthorityInfoAccess] -> ExtAuthorityInfoAccess
ExtAuthorityInfoAccess []
    extDecode (Start ASN1ConstructionType
Sequence : [ASN1]
encAia) =
        DecState
-> [ASN1]
-> [AuthorityInfoAccess]
-> Either String ExtAuthorityInfoAccess
go DecState
DecStart [ASN1]
encAia []
        where go :: DecState
-> [ASN1]
-> [AuthorityInfoAccess]
-> Either String ExtAuthorityInfoAccess
go DecState
DecStart (Start ASN1ConstructionType
Sequence : [ASN1]
next) =
                  DecState
-> [ASN1]
-> [AuthorityInfoAccess]
-> Either String ExtAuthorityInfoAccess
go DecState
DecMethod [ASN1]
next
              go DecState
DecMethod (OID [Integer]
oid : [ASN1]
next) =
                  DecState
-> [ASN1]
-> [AuthorityInfoAccess]
-> Either String ExtAuthorityInfoAccess
go ([Integer] -> DecState
DecLocation [Integer]
oid) [ASN1]
next
              go (DecLocation ([Integer] -> Maybe AIAMethod
forall a. OIDNameable a => [Integer] -> Maybe a
fromObjectID -> Just AIAMethod
v)) [ASN1]
cur
                  | Other ASN1Class
Context Int
_ ByteString
s : [ASN1]
next <- [ASN1]
cur =
                      DecState
-> [ASN1]
-> [AuthorityInfoAccess]
-> Either String ExtAuthorityInfoAccess
go DecState
DecEnd [ASN1]
next ([AuthorityInfoAccess] -> Either String ExtAuthorityInfoAccess)
-> ([AuthorityInfoAccess] -> [AuthorityInfoAccess])
-> [AuthorityInfoAccess]
-> Either String ExtAuthorityInfoAccess
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AIAMethod -> ByteString -> AuthorityInfoAccess
AuthorityInfoAccess AIAMethod
v ByteString
s AuthorityInfoAccess
-> [AuthorityInfoAccess] -> [AuthorityInfoAccess]
forall a. a -> [a] -> [a]
:)
                  | Bool
otherwise =
                      DecState
-> [ASN1]
-> [AuthorityInfoAccess]
-> Either String ExtAuthorityInfoAccess
go DecState
DecEnd ([ASN1]
 -> [AuthorityInfoAccess] -> Either String ExtAuthorityInfoAccess)
-> [ASN1]
-> [AuthorityInfoAccess]
-> Either String ExtAuthorityInfoAccess
forall a b. (a -> b) -> a -> b
$ ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence ASN1 -> [ASN1] -> [ASN1]
forall a. a -> [a] -> [a]
: ([ASN1], [ASN1]) -> [ASN1]
forall a b. (a, b) -> b
snd (Int -> [ASN1] -> ([ASN1], [ASN1])
getConstructedEnd Int
0 [ASN1]
cur)
              go DecState
DecEnd (End ASN1ConstructionType
Sequence : next :: [ASN1]
next@(Start ASN1ConstructionType
Sequence : [ASN1]
_)) =
                  DecState
-> [ASN1]
-> [AuthorityInfoAccess]
-> Either String ExtAuthorityInfoAccess
go DecState
DecStart [ASN1]
next
              go DecState
DecEnd [End ASN1ConstructionType
Sequence, End ASN1ConstructionType
Sequence] =
                  ExtAuthorityInfoAccess -> Either String ExtAuthorityInfoAccess
forall a b. b -> Either a b
Right (ExtAuthorityInfoAccess -> Either String ExtAuthorityInfoAccess)
-> ([AuthorityInfoAccess] -> ExtAuthorityInfoAccess)
-> [AuthorityInfoAccess]
-> Either String ExtAuthorityInfoAccess
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AuthorityInfoAccess] -> ExtAuthorityInfoAccess
ExtAuthorityInfoAccess ([AuthorityInfoAccess] -> ExtAuthorityInfoAccess)
-> ([AuthorityInfoAccess] -> [AuthorityInfoAccess])
-> [AuthorityInfoAccess]
-> ExtAuthorityInfoAccess
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AuthorityInfoAccess] -> [AuthorityInfoAccess]
forall a. [a] -> [a]
reverse
              go DecState
_ [ASN1]
_ =
                  Either String ExtAuthorityInfoAccess
-> [AuthorityInfoAccess] -> Either String ExtAuthorityInfoAccess
forall a b. a -> b -> a
const (Either String ExtAuthorityInfoAccess
 -> [AuthorityInfoAccess] -> Either String ExtAuthorityInfoAccess)
-> Either String ExtAuthorityInfoAccess
-> [AuthorityInfoAccess]
-> Either String ExtAuthorityInfoAccess
forall a b. (a -> b) -> a -> b
$ String -> Either String ExtAuthorityInfoAccess
forall a b. a -> Either a b
Left String
"bad AIA sequence"
    extDecode [ASN1]
_ =
        String -> Either String ExtAuthorityInfoAccess
forall a b. a -> Either a b
Left String
"bad AIA sequence"