{-# LANGUAGE OverloadedStrings #-}
module Network.DomainAuth.Pubkey.RSAPub (
lookupPublicKey,
) where
import Crypto.PubKey.RSA (PublicKey)
import Data.ASN1.BinaryEncoding (DER)
import Data.ASN1.Encoding (decodeASN1')
import Data.ASN1.Types (fromASN1)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS ()
import Data.X509 (PubKey (PubKeyRSA))
import Network.DNS (Domain)
import qualified Network.DNS as DNS
import Network.DomainAuth.Mail
import qualified Network.DomainAuth.Pubkey.Base64 as B
lookupPublicKey :: DNS.Resolver -> Domain -> IO (Maybe PublicKey)
lookupPublicKey :: Resolver -> ByteString -> IO (Maybe PublicKey)
lookupPublicKey Resolver
resolver ByteString
domain = do
Maybe ByteString
mpub <- Resolver -> ByteString -> IO (Maybe ByteString)
lookupPublicKey' Resolver
resolver ByteString
domain
Maybe PublicKey -> IO (Maybe PublicKey)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PublicKey -> IO (Maybe PublicKey))
-> Maybe PublicKey -> IO (Maybe PublicKey)
forall a b. (a -> b) -> a -> b
$ case Maybe ByteString
mpub of
Maybe ByteString
Nothing -> Maybe PublicKey
forall a. Maybe a
Nothing
Just ByteString
pub -> ByteString -> Maybe PublicKey
decodeRSAPublicyKey ByteString
pub
lookupPublicKey' :: DNS.Resolver -> Domain -> IO (Maybe ByteString)
lookupPublicKey' :: Resolver -> ByteString -> IO (Maybe ByteString)
lookupPublicKey' Resolver
resolver ByteString
domain = do
Either DNSError [ByteString]
ex <- Resolver -> ByteString -> IO (Either DNSError [ByteString])
DNS.lookupTXT Resolver
resolver ByteString
domain
case Either DNSError [ByteString]
ex of
Left DNSError
_ -> Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
Right [ByteString]
x -> Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Maybe ByteString
extractPub [ByteString]
x
extractPub :: [ByteString] -> Maybe ByteString
[ByteString]
xs = case [ByteString]
xs of
[] -> Maybe ByteString
forall a. Maybe a
Nothing
(ByteString
x : [ByteString]
_) -> ByteString -> [(ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"p" (ByteString -> [(ByteString, ByteString)]
parseTaggedValue ByteString
x)
decodeRSAPublicyKey :: ByteString -> Maybe PublicKey
decodeRSAPublicyKey :: ByteString -> Maybe PublicKey
decodeRSAPublicyKey ByteString
b64 = case DER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' (DER
forall a. HasCallStack => a
undefined :: DER) ByteString
der of
Left ASN1Error
_ -> Maybe PublicKey
forall a. Maybe a
Nothing
Right [ASN1]
ans1 -> case [ASN1] -> Either String (PubKey, [ASN1])
forall a. ASN1Object a => [ASN1] -> Either String (a, [ASN1])
fromASN1 [ASN1]
ans1 of
Right (PubKeyRSA PublicKey
p, []) -> PublicKey -> Maybe PublicKey
forall a. a -> Maybe a
Just PublicKey
p
Either String (PubKey, [ASN1])
_ -> Maybe PublicKey
forall a. Maybe a
Nothing
where
der :: ByteString
der = ByteString -> ByteString
B.decode ByteString
b64