{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

module Network.DomainAuth.DKIM.Verify (
    verifyDKIM, prepareDKIM
  ) where

import Crypto.Hash
import Crypto.PubKey.RSA
import Crypto.PubKey.RSA.PKCS15
import Data.ByteArray
import Data.ByteString (ByteString)
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Lazy as BL
import Network.DomainAuth.DKIM.Btag
import Network.DomainAuth.DKIM.Types
import Network.DomainAuth.Mail
import qualified Network.DomainAuth.Pubkey.Base64 as B
import Network.DomainAuth.Utils

----------------------------------------------------------------

prepareDKIM :: DKIM -> Mail -> Builder
prepareDKIM :: DKIM -> Mail -> Builder
prepareDKIM DKIM
dkim Mail
mail = Builder
header
  where
    Field
dkimField:[Field]
fields = ByteString -> [Field] -> [Field]
fieldsFrom ByteString
dkimFieldKey (Mail -> [Field]
mailHeader Mail
mail)
    hCanon :: Field -> ByteString
hCanon = DkimCanonAlgo -> Field -> ByteString
canonDkimField (DKIM -> DkimCanonAlgo
dkimHeaderCanon DKIM
dkim)
    canon :: Field -> Builder
canon = ByteString -> Builder
BB.byteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
removeBtagValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> ByteString
hCanon
    targets :: [Field]
targets = [ByteString] -> [Field] -> [Field]
fieldsWith (DKIM -> [ByteString]
dkimFields DKIM
dkim) [Field]
fields
    header :: Builder
header = forall a. (a -> ByteString) -> [a] -> Builder
concatCRLFWith Field -> ByteString
hCanon [Field]
targets forall a. Monoid a => a -> a -> a
+++ Field -> Builder
canon Field
dkimField

----------------------------------------------------------------

canonDkimField :: DkimCanonAlgo -> Field -> ByteString
canonDkimField :: DkimCanonAlgo -> Field -> ByteString
canonDkimField DkimCanonAlgo
DKIM_SIMPLE Field
fld  = Field -> ByteString
fieldKey Field
fld forall a. Monoid a => a -> a -> a
+++ ByteString
": " forall a. Monoid a => a -> a -> a
+++ Field -> ByteString
fieldValueFolded Field
fld
canonDkimField DkimCanonAlgo
DKIM_RELAXED Field
fld = Field -> ByteString
fieldSearchKey Field
fld forall a. Monoid a => a -> a -> a
+++ ByteString
":" forall a. Monoid a => a -> a -> a
+++ Field -> ByteString
canon Field
fld
  where
    canon :: Field -> ByteString
canon = (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile Word8 -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
removeTrailingWSP forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
reduceWSP forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BS.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> [ByteString]
fieldValue

----------------------------------------------------------------

canonDkimBody :: DkimCanonAlgo -> Body -> Builder
canonDkimBody :: DkimCanonAlgo -> Body -> Builder
canonDkimBody DkimCanonAlgo
DKIM_SIMPLE  = Body -> Builder
fromBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. Body -> Body
removeTrailingEmptyLine
canonDkimBody DkimCanonAlgo
DKIM_RELAXED = (ByteString -> ByteString) -> Body -> Builder
fromBodyWith ByteString -> ByteString
relax forall b c a. (b -> c) -> (a -> b) -> a -> c
. Body -> Body
removeTrailingEmptyLine
  where
    relax :: ByteString -> ByteString
relax = ByteString -> ByteString
removeTrailingWSP forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
reduceWSP

----------------------------------------------------------------

verifyDKIM :: Mail -> DKIM -> PublicKey -> Bool
verifyDKIM :: Mail -> DKIM -> PublicKey -> Bool
verifyDKIM Mail
mail DKIM
dkim PublicKey
pub = Mail -> ByteString
bodyHash1 Mail
mail forall a. Eq a => a -> a -> Bool
== DKIM -> ByteString
bodyHash2 DKIM
dkim Bool -> Bool -> Bool
&&
                           DkimSigAlgo -> PublicKey -> ByteString -> ByteString -> Bool
verify' (DKIM -> DkimSigAlgo
dkimSigAlgo DKIM
dkim) PublicKey
pub ByteString
cmail ByteString
sig
  where
    sig :: ByteString
sig = ByteString -> ByteString
B.decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. DKIM -> ByteString
dkimSignature forall a b. (a -> b) -> a -> b
$ DKIM
dkim
    cmail :: ByteString
cmail = ByteString -> ByteString
BL.toStrict forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
BB.toLazyByteString forall a b. (a -> b) -> a -> b
$ DKIM -> Mail -> Builder
prepareDKIM DKIM
dkim Mail
mail
    bodyHash1 :: Mail -> ByteString
bodyHash1 = forall c. ByteArray c => DkimSigAlgo -> ByteString -> c
hashAlgo2 (DKIM -> DkimSigAlgo
dkimSigAlgo DKIM
dkim) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. DkimCanonAlgo -> Body -> Builder
canonDkimBody (DKIM -> DkimCanonAlgo
dkimBodyCanon DKIM
dkim) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mail -> Body
mailBody
    bodyHash2 :: DKIM -> ByteString
bodyHash2 = ByteString -> ByteString
B.decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. DKIM -> ByteString
dkimBodyHash

verify' :: DkimSigAlgo-> PublicKey -> ByteString -> ByteString -> Bool
verify' :: DkimSigAlgo -> PublicKey -> ByteString -> ByteString -> Bool
verify' DkimSigAlgo
RSA_SHA1   = forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe hashAlg -> PublicKey -> ByteString -> ByteString -> Bool
verify (forall a. a -> Maybe a
Just SHA1
SHA1)
verify' DkimSigAlgo
RSA_SHA256 = forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe hashAlg -> PublicKey -> ByteString -> ByteString -> Bool
verify (forall a. a -> Maybe a
Just SHA256
SHA256)

hashAlgo2 :: ByteArray c => DkimSigAlgo -> ByteString -> c
hashAlgo2 :: forall c. ByteArray c => DkimSigAlgo -> ByteString -> c
hashAlgo2 DkimSigAlgo
RSA_SHA1   = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash :: ByteString -> Digest SHA1)
hashAlgo2 DkimSigAlgo
RSA_SHA256 = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash :: ByteString -> Digest SHA256)