{-# LANGUAGE OverloadedStrings #-}
module Network.DomainAuth.DKIM (
runDKIM,
runDKIM',
parseDKIM,
DKIM,
dkimDomain,
dkimSelector,
dkimFieldKey,
) where
import qualified Data.ByteString as BS
import Network.DNS as DNS (Resolver)
import Network.DomainAuth.DKIM.Parser
import Network.DomainAuth.DKIM.Types
import Network.DomainAuth.DKIM.Verify
import Network.DomainAuth.Mail
import Network.DomainAuth.Pubkey.RSAPub
import Network.DomainAuth.Types
runDKIM :: Resolver -> Mail -> IO DAResult
runDKIM :: Resolver -> Mail -> IO DAResult
runDKIM Resolver
resolver Mail
mail = IO DAResult
dkim1
where
dkim1 :: IO DAResult
dkim1 =
IO DAResult -> (Field -> IO DAResult) -> Maybe Field -> IO DAResult
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DAResult -> IO DAResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DAResult
DANone) Field -> IO DAResult
dkim2 (Maybe Field -> IO DAResult) -> Maybe Field -> IO DAResult
forall a b. (a -> b) -> a -> b
$ FieldKey -> Header -> Maybe Field
lookupField FieldKey
dkimFieldKey (Mail -> Header
mailHeader Mail
mail)
dkim2 :: Field -> IO DAResult
dkim2 Field
dkimv = IO DAResult -> (DKIM -> IO DAResult) -> Maybe DKIM -> IO DAResult
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DAResult -> IO DAResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DAResult
DAPermError) DKIM -> IO DAResult
dkim3 (Maybe DKIM -> IO DAResult) -> Maybe DKIM -> IO DAResult
forall a b. (a -> b) -> a -> b
$ FieldKey -> Maybe DKIM
parseDKIM (Field -> FieldKey
fieldValueUnfolded Field
dkimv)
dkim3 :: DKIM -> IO DAResult
dkim3 = Resolver -> Mail -> DKIM -> IO DAResult
runDKIM' Resolver
resolver Mail
mail
runDKIM' :: Resolver -> Mail -> DKIM -> IO DAResult
runDKIM' :: Resolver -> Mail -> DKIM -> IO DAResult
runDKIM' Resolver
resolver Mail
mail DKIM
dkim = DAResult -> (PublicKey -> DAResult) -> Maybe PublicKey -> DAResult
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DAResult
DATempError (Mail -> DKIM -> PublicKey -> DAResult
verify Mail
mail DKIM
dkim) (Maybe PublicKey -> DAResult)
-> IO (Maybe PublicKey) -> IO DAResult
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 = DKIM -> FieldKey
dkimSelector DKIM
dkim FieldKey -> FieldKey -> FieldKey
+++ FieldKey
"._domainkey." FieldKey -> FieldKey -> FieldKey
+++ DKIM -> FieldKey
dkimDomain DKIM
dkim
verify :: Mail -> DKIM -> PublicKey -> DAResult
verify Mail
m DKIM
d PublicKey
p = if Mail -> DKIM -> PublicKey -> Bool
verifyDKIM Mail
m DKIM
d PublicKey
p then DAResult
DAPass else DAResult
DAFail
+++ :: FieldKey -> FieldKey -> FieldKey
(+++) = FieldKey -> FieldKey -> FieldKey
BS.append