{-# LANGUAGE OverloadedStrings #-}
module Network.DomainAuth.DK (
runDK, runDK'
, parseDK
, DK, dkDomain, dkSelector
, dkFieldKey
) where
import Network.DNS as DNS (Resolver)
import Network.DomainAuth.DK.Parser
import Network.DomainAuth.DK.Types
import Network.DomainAuth.DK.Verify
import Network.DomainAuth.Mail
import Network.DomainAuth.Pubkey.RSAPub
import Network.DomainAuth.Types
import qualified Data.ByteString as BS (append)
runDK :: Resolver -> Mail -> IO DAResult
runDK :: Resolver -> Mail -> IO DAResult
runDK Resolver
resolver Mail
mail = IO DAResult
dk1
where
dk1 :: IO DAResult
dk1 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return DAResult
DANone) Field -> IO DAResult
dk2 forall a b. (a -> b) -> a -> b
$ FieldKey -> Header -> Maybe Field
lookupField FieldKey
dkFieldKey (Mail -> Header
mailHeader Mail
mail)
dk2 :: Field -> IO DAResult
dk2 Field
dkv = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return DAResult
DAPermError) DK -> IO DAResult
dk3 forall a b. (a -> b) -> a -> b
$ FieldKey -> Maybe DK
parseDK (Field -> FieldKey
fieldValueUnfolded Field
dkv)
dk3 :: DK -> IO DAResult
dk3 = Resolver -> Mail -> DK -> IO DAResult
runDK' Resolver
resolver Mail
mail
runDK' :: Resolver -> Mail -> DK -> IO DAResult
runDK' :: Resolver -> Mail -> DK -> IO DAResult
runDK' Resolver
resolver Mail
mail DK
dk = forall b a. b -> (a -> b) -> Maybe a -> b
maybe DAResult
DATempError (Mail -> DK -> PublicKey -> DAResult
verify Mail
mail DK
dk) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe PublicKey)
pub
where
pub :: IO (Maybe PublicKey)
pub = Resolver -> FieldKey -> IO (Maybe PublicKey)
lookupPublicKey Resolver
resolver FieldKey
dom
dom :: FieldKey
dom = DK -> FieldKey
dkSelector DK
dk FieldKey -> FieldKey -> FieldKey
+++ FieldKey
"._domainkey." FieldKey -> FieldKey -> FieldKey
+++ DK -> FieldKey
dkDomain DK
dk
verify :: Mail -> DK -> PublicKey -> DAResult
verify Mail
m DK
d PublicKey
p = if Mail -> DK -> PublicKey -> Bool
verifyDK Mail
m DK
d PublicKey
p then DAResult
DAPass else DAResult
DAFail
+++ :: FieldKey -> FieldKey -> FieldKey
(+++) = FieldKey -> FieldKey -> FieldKey
BS.append