module Data.X509.AlgorithmIdentifier
( HashALG(..)
, PubKeyALG(..)
, SignatureALG(..)
) where
import Data.ASN1.Types
import Data.List (find)
data HashALG =
HashMD2
| HashMD5
| HashSHA1
| HashSHA224
| HashSHA256
| HashSHA384
| HashSHA512
deriving (Int -> HashALG -> ShowS
[HashALG] -> ShowS
HashALG -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HashALG] -> ShowS
$cshowList :: [HashALG] -> ShowS
show :: HashALG -> String
$cshow :: HashALG -> String
showsPrec :: Int -> HashALG -> ShowS
$cshowsPrec :: Int -> HashALG -> ShowS
Show,HashALG -> HashALG -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HashALG -> HashALG -> Bool
$c/= :: HashALG -> HashALG -> Bool
== :: HashALG -> HashALG -> Bool
$c== :: HashALG -> HashALG -> Bool
Eq)
data PubKeyALG =
PubKeyALG_RSA
| PubKeyALG_RSAPSS
| PubKeyALG_DSA
| PubKeyALG_EC
| PubKeyALG_X25519
| PubKeyALG_X448
| PubKeyALG_Ed25519
| PubKeyALG_Ed448
| PubKeyALG_DH
| PubKeyALG_Unknown OID
deriving (Int -> PubKeyALG -> ShowS
[PubKeyALG] -> ShowS
PubKeyALG -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PubKeyALG] -> ShowS
$cshowList :: [PubKeyALG] -> ShowS
show :: PubKeyALG -> String
$cshow :: PubKeyALG -> String
showsPrec :: Int -> PubKeyALG -> ShowS
$cshowsPrec :: Int -> PubKeyALG -> ShowS
Show,PubKeyALG -> PubKeyALG -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PubKeyALG -> PubKeyALG -> Bool
$c/= :: PubKeyALG -> PubKeyALG -> Bool
== :: PubKeyALG -> PubKeyALG -> Bool
$c== :: PubKeyALG -> PubKeyALG -> Bool
Eq)
data SignatureALG =
SignatureALG HashALG PubKeyALG
| SignatureALG_IntrinsicHash PubKeyALG
| SignatureALG_Unknown OID
deriving (Int -> SignatureALG -> ShowS
[SignatureALG] -> ShowS
SignatureALG -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignatureALG] -> ShowS
$cshowList :: [SignatureALG] -> ShowS
show :: SignatureALG -> String
$cshow :: SignatureALG -> String
showsPrec :: Int -> SignatureALG -> ShowS
$cshowsPrec :: Int -> SignatureALG -> ShowS
Show,SignatureALG -> SignatureALG -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignatureALG -> SignatureALG -> Bool
$c/= :: SignatureALG -> SignatureALG -> Bool
== :: SignatureALG -> SignatureALG -> Bool
$c== :: SignatureALG -> SignatureALG -> Bool
Eq)
instance OIDable PubKeyALG where
getObjectID :: PubKeyALG -> OID
getObjectID PubKeyALG
PubKeyALG_RSA = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
1]
getObjectID PubKeyALG
PubKeyALG_RSAPSS = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
10]
getObjectID PubKeyALG
PubKeyALG_DSA = [Integer
1,Integer
2,Integer
840,Integer
10040,Integer
4,Integer
1]
getObjectID PubKeyALG
PubKeyALG_EC = [Integer
1,Integer
2,Integer
840,Integer
10045,Integer
2,Integer
1]
getObjectID PubKeyALG
PubKeyALG_X25519 = [Integer
1,Integer
3,Integer
101,Integer
110]
getObjectID PubKeyALG
PubKeyALG_X448 = [Integer
1,Integer
3,Integer
101,Integer
111]
getObjectID PubKeyALG
PubKeyALG_Ed25519 = [Integer
1,Integer
3,Integer
101,Integer
112]
getObjectID PubKeyALG
PubKeyALG_Ed448 = [Integer
1,Integer
3,Integer
101,Integer
113]
getObjectID PubKeyALG
PubKeyALG_DH = [Integer
1,Integer
2,Integer
840,Integer
10046,Integer
2,Integer
1]
getObjectID (PubKeyALG_Unknown OID
oid) = OID
oid
sig_table :: [ (OID, SignatureALG) ]
sig_table :: [(OID, SignatureALG)]
sig_table =
[ ([Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
5], HashALG -> PubKeyALG -> SignatureALG
SignatureALG HashALG
HashSHA1 PubKeyALG
PubKeyALG_RSA)
, ([Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
4], HashALG -> PubKeyALG -> SignatureALG
SignatureALG HashALG
HashMD5 PubKeyALG
PubKeyALG_RSA)
, ([Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
2], HashALG -> PubKeyALG -> SignatureALG
SignatureALG HashALG
HashMD2 PubKeyALG
PubKeyALG_RSA)
, ([Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
11], HashALG -> PubKeyALG -> SignatureALG
SignatureALG HashALG
HashSHA256 PubKeyALG
PubKeyALG_RSA)
, ([Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
12], HashALG -> PubKeyALG -> SignatureALG
SignatureALG HashALG
HashSHA384 PubKeyALG
PubKeyALG_RSA)
, ([Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
13], HashALG -> PubKeyALG -> SignatureALG
SignatureALG HashALG
HashSHA512 PubKeyALG
PubKeyALG_RSA)
, ([Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
14], HashALG -> PubKeyALG -> SignatureALG
SignatureALG HashALG
HashSHA224 PubKeyALG
PubKeyALG_RSA)
, ([Integer
1,Integer
2,Integer
840,Integer
10040,Integer
4,Integer
3], HashALG -> PubKeyALG -> SignatureALG
SignatureALG HashALG
HashSHA1 PubKeyALG
PubKeyALG_DSA)
, ([Integer
1,Integer
2,Integer
840,Integer
10045,Integer
4,Integer
1], HashALG -> PubKeyALG -> SignatureALG
SignatureALG HashALG
HashSHA1 PubKeyALG
PubKeyALG_EC)
, ([Integer
1,Integer
2,Integer
840,Integer
10045,Integer
4,Integer
3,Integer
1], HashALG -> PubKeyALG -> SignatureALG
SignatureALG HashALG
HashSHA224 PubKeyALG
PubKeyALG_EC)
, ([Integer
1,Integer
2,Integer
840,Integer
10045,Integer
4,Integer
3,Integer
2], HashALG -> PubKeyALG -> SignatureALG
SignatureALG HashALG
HashSHA256 PubKeyALG
PubKeyALG_EC)
, ([Integer
1,Integer
2,Integer
840,Integer
10045,Integer
4,Integer
3,Integer
3], HashALG -> PubKeyALG -> SignatureALG
SignatureALG HashALG
HashSHA384 PubKeyALG
PubKeyALG_EC)
, ([Integer
1,Integer
2,Integer
840,Integer
10045,Integer
4,Integer
3,Integer
4], HashALG -> PubKeyALG -> SignatureALG
SignatureALG HashALG
HashSHA512 PubKeyALG
PubKeyALG_EC)
, ([Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
2,Integer
1], HashALG -> PubKeyALG -> SignatureALG
SignatureALG HashALG
HashSHA256 PubKeyALG
PubKeyALG_RSAPSS)
, ([Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
2,Integer
2], HashALG -> PubKeyALG -> SignatureALG
SignatureALG HashALG
HashSHA384 PubKeyALG
PubKeyALG_RSAPSS)
, ([Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
2,Integer
3], HashALG -> PubKeyALG -> SignatureALG
SignatureALG HashALG
HashSHA512 PubKeyALG
PubKeyALG_RSAPSS)
, ([Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
2,Integer
4], HashALG -> PubKeyALG -> SignatureALG
SignatureALG HashALG
HashSHA224 PubKeyALG
PubKeyALG_RSAPSS)
, ([Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
3,Integer
1], HashALG -> PubKeyALG -> SignatureALG
SignatureALG HashALG
HashSHA224 PubKeyALG
PubKeyALG_DSA)
, ([Integer
2,Integer
16,Integer
840,Integer
1,Integer
101,Integer
3,Integer
4,Integer
3,Integer
2], HashALG -> PubKeyALG -> SignatureALG
SignatureALG HashALG
HashSHA256 PubKeyALG
PubKeyALG_DSA)
, ([Integer
1,Integer
3,Integer
101,Integer
112], PubKeyALG -> SignatureALG
SignatureALG_IntrinsicHash PubKeyALG
PubKeyALG_Ed25519)
, ([Integer
1,Integer
3,Integer
101,Integer
113], PubKeyALG -> SignatureALG
SignatureALG_IntrinsicHash PubKeyALG
PubKeyALG_Ed448)
]
oidSig :: OID -> SignatureALG
oidSig :: OID -> SignatureALG
oidSig OID
oid = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (OID -> SignatureALG
SignatureALG_Unknown OID
oid) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup OID
oid [(OID, SignatureALG)]
sig_table
sigOID :: SignatureALG -> OID
sigOID :: SignatureALG -> OID
sigOID (SignatureALG_Unknown OID
oid) = OID
oid
sigOID SignatureALG
sig = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => String -> a
error (String
"unknown OID for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SignatureALG
sig)) forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall a. Eq a => a -> a -> Bool
(==) SignatureALG
sig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(OID, SignatureALG)]
sig_table
saltLen :: HashALG -> Integer
saltLen :: HashALG -> Integer
saltLen HashALG
HashSHA256 = Integer
32
saltLen HashALG
HashSHA384 = Integer
48
saltLen HashALG
HashSHA512 = Integer
64
saltLen HashALG
HashSHA224 = Integer
28
saltLen HashALG
_ = forall a. HasCallStack => String -> a
error String
"toASN1: X509.SignatureAlg.HashAlg: Unknown hash"
instance ASN1Object SignatureALG where
fromASN1 :: [ASN1] -> Either String (SignatureALG, [ASN1])
fromASN1 (Start ASN1ConstructionType
Sequence:OID OID
oid:ASN1
Null:End ASN1ConstructionType
Sequence:[ASN1]
xs) =
case OID -> SignatureALG
oidSig OID
oid of
SignatureALG_IntrinsicHash PubKeyALG
_ ->
forall a b. a -> Either a b
Left String
"fromASN1: X509.SignatureALG: EdDSA requires absent parameter"
SignatureALG
signatureAlg -> forall a b. b -> Either a b
Right (SignatureALG
signatureAlg, [ASN1]
xs)
fromASN1 (Start ASN1ConstructionType
Sequence:OID OID
oid:End ASN1ConstructionType
Sequence:[ASN1]
xs) =
forall a b. b -> Either a b
Right (OID -> SignatureALG
oidSig OID
oid, [ASN1]
xs)
fromASN1 (Start ASN1ConstructionType
Sequence:OID [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
10]:Start ASN1ConstructionType
Sequence:Start ASN1ConstructionType
_:Start ASN1ConstructionType
Sequence:OID OID
hash1:End ASN1ConstructionType
Sequence:End ASN1ConstructionType
_:Start ASN1ConstructionType
_:Start ASN1ConstructionType
Sequence:OID [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
8]:Start ASN1ConstructionType
Sequence:OID OID
_hash2:End ASN1ConstructionType
Sequence:End ASN1ConstructionType
Sequence:End ASN1ConstructionType
_:Start ASN1ConstructionType
_: IntVal Integer
_iv: End ASN1ConstructionType
_: End ASN1ConstructionType
Sequence : End ASN1ConstructionType
Sequence:[ASN1]
xs) =
forall a b. b -> Either a b
Right (OID -> SignatureALG
oidSig OID
hash1, [ASN1]
xs)
fromASN1 (Start ASN1ConstructionType
Sequence:OID [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
10]:Start ASN1ConstructionType
Sequence:Start ASN1ConstructionType
_:Start ASN1ConstructionType
Sequence:OID OID
hash1:ASN1
Null:End ASN1ConstructionType
Sequence:End ASN1ConstructionType
_:Start ASN1ConstructionType
_:Start ASN1ConstructionType
Sequence:OID [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
8]:Start ASN1ConstructionType
Sequence:OID OID
_hash2:ASN1
Null:End ASN1ConstructionType
Sequence:End ASN1ConstructionType
Sequence:End ASN1ConstructionType
_:Start ASN1ConstructionType
_: IntVal Integer
_iv: End ASN1ConstructionType
_: End ASN1ConstructionType
Sequence : End ASN1ConstructionType
Sequence:[ASN1]
xs) =
forall a b. b -> Either a b
Right (OID -> SignatureALG
oidSig OID
hash1, [ASN1]
xs)
fromASN1 [ASN1]
_ =
forall a b. a -> Either a b
Left String
"fromASN1: X509.SignatureALG: unknown format"
toASN1 :: SignatureALG -> ASN1S
toASN1 (SignatureALG_Unknown OID
oid) = \[ASN1]
xs -> ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequenceforall a. a -> [a] -> [a]
:OID -> ASN1
OID OID
oidforall a. a -> [a] -> [a]
:ASN1
Nullforall a. a -> [a] -> [a]
:ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequenceforall a. a -> [a] -> [a]
:[ASN1]
xs
toASN1 signatureAlg :: SignatureALG
signatureAlg@(SignatureALG HashALG
hashAlg PubKeyALG
PubKeyALG_RSAPSS) = \[ASN1]
xs -> ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequenceforall a. a -> [a] -> [a]
:OID -> ASN1
OID [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
10]forall a. a -> [a] -> [a]
:ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequenceforall a. a -> [a] -> [a]
:ASN1ConstructionType -> ASN1
Start (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0)forall a. a -> [a] -> [a]
:ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequenceforall a. a -> [a] -> [a]
:OID -> ASN1
OID (SignatureALG -> OID
sigOID SignatureALG
signatureAlg)forall a. a -> [a] -> [a]
:ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequenceforall a. a -> [a] -> [a]
:ASN1ConstructionType -> ASN1
End (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0)forall a. a -> [a] -> [a]
:ASN1ConstructionType -> ASN1
Start (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1)forall a. a -> [a] -> [a]
: ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequenceforall a. a -> [a] -> [a]
:OID -> ASN1
OID [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
8]forall a. a -> [a] -> [a]
:ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequenceforall a. a -> [a] -> [a]
:OID -> ASN1
OID (SignatureALG -> OID
sigOID SignatureALG
signatureAlg)forall a. a -> [a] -> [a]
:ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequenceforall a. a -> [a] -> [a]
:ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequenceforall a. a -> [a] -> [a]
:ASN1ConstructionType -> ASN1
End (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1)forall a. a -> [a] -> [a]
:ASN1ConstructionType -> ASN1
Start (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
2)forall a. a -> [a] -> [a]
:Integer -> ASN1
IntVal (HashALG -> Integer
saltLen HashALG
hashAlg)forall a. a -> [a] -> [a]
:ASN1ConstructionType -> ASN1
End (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
2)forall a. a -> [a] -> [a]
:ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequenceforall a. a -> [a] -> [a]
:ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequenceforall a. a -> [a] -> [a]
:[ASN1]
xs
toASN1 signatureAlg :: SignatureALG
signatureAlg@(SignatureALG_IntrinsicHash PubKeyALG
_) = \[ASN1]
xs -> ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequenceforall a. a -> [a] -> [a]
:OID -> ASN1
OID (SignatureALG -> OID
sigOID SignatureALG
signatureAlg)forall a. a -> [a] -> [a]
:ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequenceforall a. a -> [a] -> [a]
:[ASN1]
xs
toASN1 SignatureALG
signatureAlg = \[ASN1]
xs -> ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequenceforall a. a -> [a] -> [a]
:OID -> ASN1
OID (SignatureALG -> OID
sigOID SignatureALG
signatureAlg)forall a. a -> [a] -> [a]
:ASN1
Nullforall a. a -> [a] -> [a]
:ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequenceforall a. a -> [a] -> [a]
:[ASN1]
xs