diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,29 @@
+Copyright (c) 2009, IIJ Innovation Institute Inc.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+  * Redistributions of source code must retain the above copyright
+    notice, this list of conditions and the following disclaimer.
+  * Redistributions in binary form must reproduce the above copyright
+    notice, this list of conditions and the following disclaimer in
+    the documentation and/or other materials provided with the
+    distribution.
+  * Neither the name of the copyright holders nor the names of its
+    contributors may be used to endorse or promote products derived
+    from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
diff --git a/Network/DomainAuth.hs b/Network/DomainAuth.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth.hs
@@ -0,0 +1,19 @@
+{-|
+  Library for Sender Policy Framework, SenderID, DomainKeys and DKIM.
+-}
+
+module Network.DomainAuth (
+    module Network.DomainAuth.Mail
+  , module Network.DomainAuth.DK
+  , module Network.DomainAuth.DKIM
+  , module Network.DomainAuth.PRD
+  , module Network.DomainAuth.SPF
+  , module Network.DomainAuth.Types
+  ) where
+
+import Network.DomainAuth.Mail
+import Network.DomainAuth.DK
+import Network.DomainAuth.DKIM
+import Network.DomainAuth.PRD
+import Network.DomainAuth.SPF
+import Network.DomainAuth.Types
diff --git a/Network/DomainAuth/DK.hs b/Network/DomainAuth/DK.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/DK.hs
@@ -0,0 +1,45 @@
+{-|
+  A library for DomainKeys (<http://www.ietf.org/rfc/rfc4070>).
+  Currently, only receiver side is implemented.
+-}
+
+module Network.DomainAuth.DK (
+  -- * Documentation
+  -- ** Authentication with DK
+    runDK, runDK'
+  -- ** Parsing DomainKey-Signature:
+  , parseDK
+  , DK, dkDomain, dkSelector
+  -- ** Field key for DomainKey-Signature:
+  , dkFieldKey
+  ) where
+
+import Control.Applicative
+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
+
+{-|
+  Verifying 'Mail' with DomainKeys.
+-}
+runDK :: Resolver -> Mail -> IO DAResult
+runDK resolver mail = dk1
+  where
+    dk1     = maybe (return DANone)      dk2 $ lookupField dkFieldKey (mailHeader mail)
+    dk2 dkv = maybe (return DAPermError) dk3 $ parseDK (fieldValueUnfolded dkv)
+    dk3     = runDK' resolver mail
+
+{-|
+  Verifying 'Mail' with DomainKeys. The value of DomainKey-Signature:
+  should be parsed beforehand.
+-}
+runDK' :: Resolver -> Mail -> DK -> IO DAResult
+runDK' resolver mail dk = maybe DATempError (verify mail dk) <$> pub
+  where
+    pub = lookupPublicKey resolver dom
+    dom = dkSelector dk ++ "._domainkey." ++ dkDomain dk
+    verify m d p = if verifyDK m d p then DAPass else DAFail
diff --git a/Network/DomainAuth/DK/Parser.hs b/Network/DomainAuth/DK/Parser.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/DK/Parser.hs
@@ -0,0 +1,100 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.DomainAuth.DK.Parser where
+
+import qualified Data.ByteString.Lazy.Char8 as L
+import Data.List
+import qualified Data.Map as M
+import Data.Maybe
+import Network.DomainAuth.DK.Types
+import Network.DomainAuth.Mail
+import Prelude hiding (catch)
+
+{-|
+  Parsing DomainKey-Signature:.
+-}
+parseDK :: RawFieldValue -> Maybe DK
+parseDK val = toDK domkey
+  where
+    (ts,vs) = unzip $ parseTaggedValue val
+    fs = map tagToSetter ts
+    tagToSetter tag = fromMaybe (\_ mdk -> mdk) $ lookup (L.head tag) dkTagDB
+    pfs = zipWith ($) fs vs
+    domkey = foldr ($) initialMDK pfs
+    toDK mdk = do
+        alg <- mdkAlgorithm mdk
+        sig <- mdkSignature mdk
+        cal <- mdkCanonAlgo mdk
+        dom <- mdkDomain    mdk
+        sel <- mdkSelector  mdk
+        return DK {
+            dkAlgorithm = alg
+          , dkSignature = sig
+          , dkCanonAlgo = cal
+          , dkDomain0   = dom
+          , dkFields    = mdkFields mdk
+          , dkSelector0 = sel
+          }
+
+data MDK = MDK {
+    mdkAlgorithm :: Maybe DkAlgorithm
+  , mdkSignature :: Maybe L.ByteString
+  , mdkCanonAlgo :: Maybe DkCanonAlgo
+  , mdkDomain    :: Maybe L.ByteString
+  , mdkFields    :: Maybe DkFields
+  , mdkSelector  :: Maybe L.ByteString
+  } deriving (Eq,Show)
+
+initialMDK :: MDK
+initialMDK = MDK {
+    mdkAlgorithm = Just DK_RSA_SHA1
+  , mdkSignature = Nothing
+  , mdkCanonAlgo = Nothing
+  , mdkDomain    = Nothing
+  , mdkFields    = Nothing
+  , mdkSelector  = Nothing
+  }
+
+type DKSetter = L.ByteString -> MDK -> MDK
+
+dkTagDB :: [(Char,DKSetter)]
+dkTagDB = [
+    ('a',setDkAlgorithm)
+  , ('b',setDkSignature)
+  , ('c',setDkCanonAlgo)
+  , ('d',setDkDomain)
+  , ('h',setDkFields)
+--  , ('q',setDkQuery)
+  , ('s',setDkSelector)
+  ]
+
+setDkAlgorithm :: DKSetter
+setDkAlgorithm "rsa-sha1" dk = dk { mdkAlgorithm = Just DK_RSA_SHA1 }
+setDkAlgorithm _ _           = error "setDkAlgorithm"
+
+setDkSignature :: DKSetter
+setDkSignature sig dk = dk { mdkSignature = Just sig }
+
+setDkCanonAlgo :: DKSetter
+setDkCanonAlgo "simple" dk = dk { mdkCanonAlgo = Just DK_SIMPLE }
+setDkCanonAlgo "nofws"  dk = dk { mdkCanonAlgo = Just DK_NOFWS }
+setDkCanonAlgo  _ _        = error "setDkCanonAlgo"
+
+setDkDomain :: DKSetter
+setDkDomain dom dk = dk { mdkDomain = Just dom }
+
+setDkFields :: DKSetter
+setDkFields keys dk = dk { mdkFields = Just mx }
+  where
+    flds = L.split ':' keys
+    mx = foldl' func M.empty flds
+    func m fld = M.insert fld True m
+
+{-
+setDkQuery :: DKSetter
+setDkQuery "dns" dk = dk { mdkQuery = Just DK_DNS }
+setDkQuery _ _      = error "setDkQuery"
+-}
+
+setDkSelector :: DKSetter
+setDkSelector sel dk = dk { mdkSelector = Just sel }
diff --git a/Network/DomainAuth/DK/Types.hs b/Network/DomainAuth/DK/Types.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/DK/Types.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.DomainAuth.DK.Types where
+
+import qualified Data.ByteString.Lazy.Char8 as L
+import qualified Data.Map as M
+import Network.DNS
+import Network.DomainAuth.Mail
+
+----------------------------------------------------------------
+
+{-|
+  Canonicalized key for DomainKey-Signature:.
+-}
+dkFieldKey :: CanonFieldKey
+dkFieldKey = "domainkey-signature"
+
+----------------------------------------------------------------
+
+data DkAlgorithm = DK_RSA_SHA1 deriving (Eq,Show)
+data DkCanonAlgo = DK_SIMPLE | DK_NOFWS deriving (Eq,Show)
+--data DkQuery = DK_DNS deriving (Eq,Show)
+type DkFields = M.Map L.ByteString Bool -- Key Bool
+
+{-|
+  Abstract type for DomainKey-Signature:
+-}
+
+data DK = DK {
+    dkAlgorithm :: DkAlgorithm
+  , dkSignature :: L.ByteString
+  , dkCanonAlgo :: DkCanonAlgo
+  , dkDomain0   :: L.ByteString
+  , dkFields    :: Maybe DkFields
+--  , dkQuery     :: Maybe DkQuery -- gmail does not provide, sigh
+  , dkSelector0 :: L.ByteString
+  } deriving (Eq,Show)
+
+{-|
+  Getting of the value of the \"d\" tag in DomainKey-Signature:.
+-}
+dkDomain :: DK -> Domain
+dkDomain = L.unpack . dkDomain0
+
+{-|
+  Getting of the value of the \"s\" tag in DomainKey-Signature:.
+-}
+dkSelector :: DK -> String
+dkSelector = L.unpack . dkSelector0
diff --git a/Network/DomainAuth/DK/Verify.hs b/Network/DomainAuth/DK/Verify.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/DK/Verify.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.DomainAuth.DK.Verify (
+    verifyDK, prepareDK
+  ) where
+
+import Codec.Crypto.RSA
+import qualified Data.ByteString.Lazy.Char8 as L
+import qualified Data.Map as M
+import Network.DomainAuth.DK.Types
+import Network.DomainAuth.Mail
+import qualified Network.DomainAuth.Pubkey.Base64 as B
+import Network.DomainAuth.Utils
+
+----------------------------------------------------------------
+
+prepareDK :: DK -> Mail -> L.ByteString
+prepareDK dk mail = cmail
+  where
+    header' = canonDkHeader dk (mailHeader mail)
+    body'   = canonDkBody (dkCanonAlgo dk) (mailBody mail)
+    cmail   = if body' == "" then header' else header' `appendCRLF` body'
+
+----------------------------------------------------------------
+
+canonDkHeader :: DK -> Header -> L.ByteString
+canonDkHeader dk hdr = concatCRLFWith (canonDkField calgo) flds
+  where
+    calgo = dkCanonAlgo dk
+    hFields = dkFields dk
+    flds = prepareDkHeader hFields hdr
+
+canonDkField :: DkCanonAlgo -> Field -> L.ByteString
+canonDkField DK_SIMPLE fld = fieldKey fld +++ ": " +++ fieldValueFolded fld
+canonDkField DK_NOFWS  fld = fieldKey fld +++ ":" +++ removeFWS (fieldValueUnfolded fld)
+
+prepareDkHeader :: Maybe DkFields -> Header -> Header
+prepareDkHeader Nothing hdr = fieldsAfter dkFieldKey hdr
+prepareDkHeader (Just hFields) hdr = filter isInHTag $ fieldsAfter dkFieldKey hdr
+  where
+    isInHTag fld = M.member (fieldSearchKey fld) hFields
+
+----------------------------------------------------------------
+
+canonDkBody :: DkCanonAlgo -> Body -> L.ByteString
+canonDkBody DK_SIMPLE = fromBody . removeTrailingEmptyLine
+canonDkBody DK_NOFWS  = fromBodyWith removeFWS . removeTrailingEmptyLine
+
+----------------------------------------------------------------
+
+verifyDK :: Mail -> DK -> PublicKey -> Bool
+verifyDK mail dk pub = rsassa_pkcs1_v1_5_verify ha_SHA1 pub cmail sig
+  where
+    sig = B.decode (dkSignature dk)
+    cmail = prepareDK dk mail
diff --git a/Network/DomainAuth/DKIM.hs b/Network/DomainAuth/DKIM.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/DKIM.hs
@@ -0,0 +1,45 @@
+{-|
+  A library for DKIM (<http://www.ietf.org/rfc/rfc4071>).
+  Currently, only receiver side is implemented.
+-}
+
+module Network.DomainAuth.DKIM (
+  -- * Documentation
+  -- ** Authentication with DKIM
+    runDKIM, runDKIM'
+  -- ** Parsing DKIM-Signature:
+  , parseDKIM
+  , DKIM, dkimDomain, dkimSelector
+  -- ** Field key for DKIM-Signature:
+  , dkimFieldKey
+  ) where
+
+import Control.Applicative
+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
+
+{-|
+  Verifying 'Mail' with DKIM.
+-}
+runDKIM :: Resolver -> Mail -> IO DAResult
+runDKIM resolver mail = dkim1
+  where
+    dkim1       = maybe (return DANone)      dkim2 $ lookupField dkimFieldKey (mailHeader mail)
+    dkim2 dkimv = maybe (return DAPermError) dkim3 $ parseDKIM (fieldValueUnfolded dkimv)
+    dkim3       = runDKIM' resolver mail
+
+{-|
+  Verifying 'Mail' with DKIM. The value of DKIM-Signature:
+  should be parsed beforehand.
+-}
+runDKIM' :: Resolver -> Mail -> DKIM -> IO DAResult
+runDKIM' resolver mail dkim = maybe DATempError (verify mail dkim) <$> pub
+  where
+    pub = lookupPublicKey resolver dom
+    dom = dkimSelector dkim ++ "._domainkey." ++ dkimDomain dkim
+    verify m d p = if verifyDKIM m d p then DAPass else DAFail
diff --git a/Network/DomainAuth/DKIM/Btag.hs b/Network/DomainAuth/DKIM/Btag.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/DKIM/Btag.hs
@@ -0,0 +1,24 @@
+module Network.DomainAuth.DKIM.Btag where
+
+import Control.Applicative
+import Data.ByteString.Lazy.Char8
+import Data.Maybe
+import Text.Appar.LazyByteString
+
+removeBtagValue :: ByteString -> ByteString
+removeBtagValue = pack . fromMaybe "" . parse remBtagValue
+
+remBtagValue :: Parser String
+remBtagValue = (++) <$> inFix btag <*> many anyChar
+
+inFix :: Parser String -> Parser String
+inFix p = try p <|> (:) <$> anyChar <*> inFix p
+
+btag :: Parser String
+btag = do
+    b <- string "b"
+    w <- many $ oneOf " \t\r\n"
+    e <- string "="
+    some $ noneOf ";"
+    s <- option "" (string ";")
+    return $ b ++ w ++ e ++ s
diff --git a/Network/DomainAuth/DKIM/Parser.hs b/Network/DomainAuth/DKIM/Parser.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/DKIM/Parser.hs
@@ -0,0 +1,137 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.DomainAuth.DKIM.Parser where
+
+import Control.Applicative
+import qualified Data.ByteString.Lazy.Char8 as L
+import Data.Maybe
+import Network.DomainAuth.DKIM.Types
+import Network.DomainAuth.Mail
+import Prelude hiding (catch)
+
+{-|
+  Parsing DKIM-Signature:.
+-}
+parseDKIM :: RawFieldValue -> Maybe DKIM
+parseDKIM val = toDKIM domkey
+  where
+    (ts,vs) = unzip $ parseTaggedValue val
+    fs = map tagToSetter ts
+    tagToSetter tag = fromMaybe (\_ mdkim -> mdkim) $ lookup (L.unpack tag) dkimTagDB
+    pfs = zipWith ($) fs vs
+    domkey = foldr ($) initialMDKIM pfs
+    toDKIM mdkim = do
+        ver <- mdkimVersion     mdkim
+        alg <- mdkimSigAlgo     mdkim
+        sig <- mdkimSignature   mdkim
+        bhs <- mdkimBodyHash    mdkim
+        hca <- mdkimHeaderCanon mdkim
+        bca <- mdkimBodyCanon   mdkim
+        dom <- mdkimDomain      mdkim
+        fld <- mdkimFields      mdkim
+        sel <- mdkimSelector    mdkim
+        return DKIM {
+            dkimVersion     = ver
+          , dkimSigAlgo     = alg
+          , dkimSignature   = sig
+          , dkimBodyHash    = bhs
+          , dkimHeaderCanon = hca
+          , dkimBodyCanon   = bca
+          , dkimDomain0     = dom
+          , dkimFields      = fld
+          , dkimLength      = mdkimLength mdkim
+          , dkimSelector0   = sel
+          }
+
+data MDKIM = MDKIM {
+    mdkimVersion     :: Maybe L.ByteString
+  , mdkimSigAlgo     :: Maybe DkimSigAlgo
+  , mdkimSignature   :: Maybe L.ByteString
+  , mdkimBodyHash    :: Maybe L.ByteString
+  , mdkimHeaderCanon :: Maybe DkimCanonAlgo
+  , mdkimBodyCanon   :: Maybe DkimCanonAlgo
+  , mdkimDomain      :: Maybe L.ByteString
+  , mdkimFields      :: Maybe [CanonFieldKey]
+  , mdkimLength      :: Maybe Int
+  , mdkimSelector    :: Maybe L.ByteString
+  } deriving (Eq,Show)
+
+initialMDKIM :: MDKIM
+initialMDKIM = MDKIM {
+    mdkimVersion     = Nothing
+  , mdkimSigAlgo     = Nothing
+  , mdkimSignature   = Nothing
+  , mdkimBodyHash    = Nothing
+  , mdkimHeaderCanon = Just DKIM_SIMPLE
+  , mdkimBodyCanon   = Just DKIM_SIMPLE
+  , mdkimDomain      = Nothing
+  , mdkimFields      = Nothing
+  , mdkimLength      = Nothing
+  , mdkimSelector    = Nothing
+  }
+
+type DKIMSetter = L.ByteString -> MDKIM -> MDKIM
+
+dkimTagDB :: [(String,DKIMSetter)]
+dkimTagDB = [
+    ("v",setDkimVersion)
+  , ("a",setDkimSigAlgo)
+  , ("b",setDkimSignature)
+  , ("bh",setDkimBodyHash)
+  , ("c",setDkimCanonAlgo)
+  , ("d",setDkimDomain)
+  , ("h",setDkimFields)
+  , ("l",setDkimLength)
+  , ("s",setDkimSelector)
+  ]
+
+setDkimVersion :: DKIMSetter
+setDkimVersion ver dkim = dkim { mdkimVersion = Just ver }
+
+setDkimSigAlgo :: DKIMSetter
+setDkimSigAlgo "rsa-sha1" dkim = dkim { mdkimSigAlgo = Just RSA_SHA1 }
+setDkimSigAlgo "rsa-sha256" dkim = dkim { mdkimSigAlgo = Just RSA_SHA256 }
+setDkimSigAlgo _ _ = error "setDkimSigAlgo"
+
+setDkimSignature :: DKIMSetter
+setDkimSignature sig dkim = dkim { mdkimSignature = Just sig }
+
+setDkimBodyHash :: DKIMSetter
+setDkimBodyHash bh dkim = dkim { mdkimBodyHash = Just bh }
+
+setDkimCanonAlgo :: DKIMSetter
+setDkimCanonAlgo "relaxed" dkim = dkim {
+    mdkimHeaderCanon = Just DKIM_RELAXED
+  , mdkimBodyCanon   = Just DKIM_SIMPLE
+  }
+setDkimCanonAlgo "relaxed/relaxed" dkim = dkim {
+    mdkimHeaderCanon = Just DKIM_RELAXED
+  , mdkimBodyCanon   = Just DKIM_RELAXED
+  }
+setDkimCanonAlgo "relaxed/simple" dkim = dkim {
+    mdkimHeaderCanon = Just DKIM_RELAXED
+  , mdkimBodyCanon   = Just DKIM_SIMPLE
+  }
+setDkimCanonAlgo "simple/relaxed" dkim = dkim {
+    mdkimHeaderCanon = Just DKIM_SIMPLE
+  , mdkimBodyCanon   = Just DKIM_RELAXED
+  }
+setDkimCanonAlgo "simple/simple" dkim = dkim {
+    mdkimHeaderCanon = Just DKIM_SIMPLE
+  , mdkimBodyCanon   = Just DKIM_SIMPLE
+  }
+setDkimCanonAlgo _ _ = error "setDkimCanonAlgo"
+
+setDkimDomain :: DKIMSetter
+setDkimDomain dom dkim = dkim { mdkimDomain = Just dom }
+
+setDkimFields :: DKIMSetter
+setDkimFields keys dkim = dkim { mdkimFields = Just flds }
+  where
+    flds = map canonicalizeKey $ L.split ':' keys
+
+setDkimLength :: DKIMSetter
+setDkimLength len dkim = dkim { mdkimLength = fst <$> L.readInt len }
+
+setDkimSelector :: DKIMSetter
+setDkimSelector sel dkim = dkim { mdkimSelector = Just sel }
diff --git a/Network/DomainAuth/DKIM/Types.hs b/Network/DomainAuth/DKIM/Types.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/DKIM/Types.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.DomainAuth.DKIM.Types where
+
+import qualified Data.ByteString.Lazy.Char8 as L
+import Network.DNS
+import Network.DomainAuth.Mail
+
+----------------------------------------------------------------
+
+{-|
+  Canonicalized key for DKIM-Signature:.
+-}
+dkimFieldKey :: CanonFieldKey
+dkimFieldKey = "dkim-signature"
+
+----------------------------------------------------------------
+
+data DkimSigAlgo = RSA_SHA1 | RSA_SHA256 deriving (Eq,Show)
+data DkimCanonAlgo = DKIM_SIMPLE | DKIM_RELAXED deriving (Eq,Show)
+
+data DKIM = DKIM {
+    dkimVersion     :: L.ByteString
+  , dkimSigAlgo     :: DkimSigAlgo
+  , dkimSignature   :: L.ByteString
+  , dkimBodyHash    :: L.ByteString
+  , dkimHeaderCanon :: DkimCanonAlgo
+  , dkimBodyCanon   :: DkimCanonAlgo
+  , dkimDomain0     :: L.ByteString
+  , dkimFields      :: [CanonFieldKey]
+  , dkimLength      :: Maybe Int
+  , dkimSelector0   :: L.ByteString
+  } deriving (Eq,Show)
+
+{-|
+  Getting of the value of the \"d\" tag in DKIM-Signature:.
+-}
+dkimDomain :: DKIM -> Domain
+dkimDomain = L.unpack . dkimDomain0
+
+{-|
+  Getting of the value of the \"s\" tag in DKIM-Signature:.
+-}
+dkimSelector :: DKIM -> String
+dkimSelector = L.unpack . dkimSelector0
diff --git a/Network/DomainAuth/DKIM/Verify.hs b/Network/DomainAuth/DKIM/Verify.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/DKIM/Verify.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.DomainAuth.DKIM.Verify (
+    verifyDKIM, prepareDKIM
+  ) where
+
+import Codec.Crypto.RSA
+import qualified Data.ByteString.Lazy.Char8 as L
+import Data.Char
+import Data.Digest.Pure.SHA
+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 -> L.ByteString
+prepareDKIM dkim mail = header
+  where
+    dkimField:fields = fieldsFrom dkimFieldKey (mailHeader mail)
+    hCanon = canonDkimField (dkimHeaderCanon dkim)
+    canon = removeBtagValue . hCanon
+    targets = fieldsWith (dkimFields dkim) fields
+    header = concatCRLFWith hCanon targets +++ canon dkimField
+
+----------------------------------------------------------------
+
+canonDkimField :: DkimCanonAlgo -> Field -> L.ByteString
+canonDkimField DKIM_SIMPLE fld  = fieldKey fld +++ ": " +++ fieldValueFolded fld
+canonDkimField DKIM_RELAXED fld = fieldSearchKey fld +++ ":" +++ canon fld
+  where
+    canon = L.dropWhile isSpace . removeTrailingWSP . reduceWSP . L.concat . fieldValue
+
+----------------------------------------------------------------
+
+canonDkimBody :: DkimCanonAlgo -> Body -> L.ByteString
+canonDkimBody DKIM_SIMPLE  = fromBody . removeTrailingEmptyLine
+canonDkimBody DKIM_RELAXED = fromBodyWith relax . removeTrailingEmptyLine
+  where
+    relax = removeTrailingWSP . reduceWSP
+
+----------------------------------------------------------------
+
+verifyDKIM :: Mail -> DKIM -> PublicKey -> Bool
+verifyDKIM mail dkim pub = bodyHash1 mail == bodyHash2 dkim &&
+                           rsassa_pkcs1_v1_5_verify hashfunc pub cmail sig
+  where
+    hashfunc = hashAlgo1 (dkimSigAlgo dkim)
+    hashfunc2 = hashAlgo2 (dkimSigAlgo dkim)
+    sig = B.decode (dkimSignature dkim)
+    cmail = prepareDKIM dkim mail
+    bodyHash1 = bytestringDigest . hashfunc2 . canonDkimBody (dkimBodyCanon dkim) . mailBody
+    bodyHash2 = B.decode . dkimBodyHash
+
+hashAlgo1 :: DkimSigAlgo -> HashInfo
+hashAlgo1 RSA_SHA1   = ha_SHA1
+hashAlgo1 RSA_SHA256 = ha_SHA256
+
+hashAlgo2 :: DkimSigAlgo -> L.ByteString -> Digest
+hashAlgo2 RSA_SHA1   = sha1
+hashAlgo2 RSA_SHA256 = sha256
+
+
diff --git a/Network/DomainAuth/Mail.hs b/Network/DomainAuth/Mail.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/Mail.hs
@@ -0,0 +1,40 @@
+{-|
+  A library to parse e-mail messages both from a file and Milter(<https://www.milter.org/>).
+-}
+
+module Network.DomainAuth.Mail (
+  -- * Documentation
+  -- ** Types for raw e-mail message
+    RawMail
+  , RawFieldKey
+  , RawFieldValue
+  , RawBodyChunk
+  -- ** Types for parsed e-mail message
+  , Mail(..), Header, Field(..), CanonFieldKey, FieldKey, FieldValue, Body
+  , canonicalizeKey
+  -- ** Obtaining 'Mail'
+  , readMail, getMail
+  -- ** Obtaining 'Mail' incrementally.
+  , XMail(..)
+  , initialXMail
+  , pushField, pushBody, finalizeMail
+  -- ** Functions to manipulate 'Header'
+  , lookupField
+  , fieldsFrom
+  , fieldsAfter
+  , fieldsWith
+  -- ** Functions to manipulate 'Field'
+  , fieldValueFolded
+  , fieldValueUnfolded
+  -- ** Functions to manipulate 'Body'
+  , fromBody
+  , fromBodyWith
+  , removeTrailingEmptyLine
+  -- ** Special function for DomainKeys and DKIM
+  , parseTaggedValue
+  ) where
+
+import Network.DomainAuth.Mail.Mail
+import Network.DomainAuth.Mail.Parser
+import Network.DomainAuth.Mail.Types
+import Network.DomainAuth.Mail.XMail
diff --git a/Network/DomainAuth/Mail/Mail.hs b/Network/DomainAuth/Mail/Mail.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/Mail/Mail.hs
@@ -0,0 +1,86 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.DomainAuth.Mail.Mail where
+
+import qualified Data.ByteString.Lazy.Char8 as L
+import qualified Data.Foldable as F (foldr)
+import Data.List
+import Data.Sequence (Seq, viewr, ViewR(..), empty)
+import Network.DomainAuth.Mail.Types
+import Network.DomainAuth.Utils
+
+----------------------------------------------------------------
+
+-- | Looking up 'Field' from 'Header' with 'FieldKey'.
+lookupField :: FieldKey -> Header -> Maybe Field
+lookupField key hdr = find (ckey `isKeyOf`) hdr
+  where
+    ckey = canonicalizeKey key
+
+-- | Obtaining the 'Field' of 'FieldKey' and all fields under 'FieldKey'.
+fieldsFrom :: FieldKey -> Header -> Header
+fieldsFrom key = dropWhile (ckey `isNotKeyOf`)
+  where
+    ckey = canonicalizeKey key
+
+-- | Obtaining all fields under 'FieldKey'.
+fieldsAfter :: FieldKey -> Header -> Header
+fieldsAfter key = safeTail . fieldsFrom key
+  where
+    safeTail [] = []
+    safeTail xs = tail xs
+
+{-
+  RFC 4871 is ambiguous, so implement only normal case.
+-}
+-- | Obtaining all fields with DKIM algorithm.
+fieldsWith :: [CanonFieldKey] -> Header -> Header
+fieldsWith [] _ = []
+fieldsWith _ [] = []
+fieldsWith (k:ks) is
+  | fs == []  = fieldsWith (k:ks) (tail is')
+  | otherwise = take len (reverse fs) ++ fieldsWith ks' is'
+  where
+    (fs,is') = span (\fld -> fieldSearchKey fld == k) is
+    (kx,ks') = span (==k) ks
+    len = length kx + 1 -- including k
+
+----------------------------------------------------------------
+
+isKeyOf :: CanonFieldKey -> Field -> Bool
+isKeyOf key fld = fieldSearchKey fld == key
+
+isNotKeyOf :: CanonFieldKey -> Field -> Bool
+isNotKeyOf key fld = fieldSearchKey fld /= key
+
+----------------------------------------------------------------
+
+-- | Obtaining folded (raw) field value.
+fieldValueFolded :: Field -> RawFieldValue
+fieldValueFolded = concatCRLF . fieldValue
+
+-- | Obtaining unfolded (removing CRLF) field value.
+fieldValueUnfolded :: Field -> RawFieldValue
+fieldValueUnfolded = L.concat . fieldValue
+
+----------------------------------------------------------------
+
+-- | Obtaining body.
+fromBody :: Body -> L.ByteString
+fromBody = fromBodyWith id
+
+-- | Obtaining body with a canonicalization function.
+fromBodyWith :: (L.ByteString -> L.ByteString) -> Body -> L.ByteString
+fromBodyWith modify = F.foldr (appendCRLFWith modify) ""
+
+-- | Removing trailing empty lines.
+removeTrailingEmptyLine :: Body -> Body
+removeTrailingEmptyLine = dropWhileR (=="")
+
+-- dropWhileR is buggy, sigh.
+dropWhileR :: (a -> Bool) -> Seq a -> Seq a
+dropWhileR p xs = case viewr xs of
+    EmptyR        -> empty
+    xs' :> x
+      | p x       -> dropWhileR p xs'
+      | otherwise -> xs
diff --git a/Network/DomainAuth/Mail/Parser.hs b/Network/DomainAuth/Mail/Parser.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/Mail/Parser.hs
@@ -0,0 +1,117 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.DomainAuth.Mail.Parser where
+
+import Control.Applicative
+import qualified Data.ByteString.Lazy.Char8 as L
+import Data.Char
+import Data.Int
+import Network.DomainAuth.Mail.Types
+import Network.DomainAuth.Mail.XMail
+import Network.DomainAuth.Utils
+
+----------------------------------------------------------------
+
+-- | Obtain 'Mail' from a file.
+readMail :: FilePath -> IO Mail
+readMail file = getMail <$> L.readFile file
+
+----------------------------------------------------------------
+
+-- | Obtain 'Mail' from 'RawMail'.
+getMail :: RawMail -> Mail
+getMail bs = finalizeMail $ pushBody rbdy xmail
+  where
+    (rhdr,rbdy) = splitHeaderBody bs
+    rflds = splitFields rhdr
+    xmail = foldl push initialXMail rflds
+    push m fld = let (k,v) = parseField fld
+                 in pushField k v m
+
+----------------------------------------------------------------
+
+splitHeaderBody :: RawMail -> (RawHeader,RawBody)
+splitHeaderBody bs = case mcnt of
+    Nothing  -> (bs,"")
+    Just cnt -> check (L.splitAt cnt bs)
+  where
+    mcnt = findEOH bs 0
+    check (hdr,bdy) = (hdr, dropSep bdy)
+    dropSep bdy
+      | len == 0 = ""
+      | len == 1 = ""
+      | otherwise = if b1 == '\r' then bdy3 else bdy2
+      where
+        len = L.length bdy
+        b1 = L.head bdy
+        bdy2 = L.tail bdy
+        bdy3 = L.tail bdy2
+
+findEOH :: RawMail -> Int64 -> Maybe Int64
+findEOH "" _ = Nothing
+findEOH bs cnt
+  | b0 == '\n' && bs1 /= "" && b1 == '\n' = Just (cnt + 1)
+  | b0 == '\n' && bs1 /= "" && b1 == '\r'
+               && bs2 /= "" && b2 == '\n' = Just (cnt + 1)
+  | otherwise                             = findEOH bs1 (cnt + 1)
+  where
+    b0  = L.head bs
+    bs1 = L.tail bs
+    b1  = L.head bs1
+    bs2 = L.tail bs1
+    b2  = L.head bs2
+
+----------------------------------------------------------------
+
+splitFields :: RawHeader -> [RawField]
+splitFields "" = []
+splitFields bs = fld : splitFields bs''
+  where
+    -- split before '\n' for efficiency
+    (fld,bs') = L.splitAt (findFieldEnd bs 0 - 1) bs
+    bs'' = L.tail bs'
+
+findFieldEnd :: RawMail -> Int64 -> Int64
+findFieldEnd bs cnt
+    | bs == ""   = cnt
+    | b  == '\n' = begOfLine bs' (cnt + 1)
+    | otherwise  = findFieldEnd bs' (cnt + 1)
+  where
+    b   = L.head bs
+    bs' = L.tail bs
+
+begOfLine :: RawMail -> Int64 -> Int64
+begOfLine bs cnt
+    | bs == ""      = cnt
+    | isContinued b = findFieldEnd bs' (cnt + 1)
+    | otherwise     = cnt
+  where
+    b   = L.head bs
+    bs' = L.tail bs
+
+isContinued :: Char -> Bool
+isContinued c = c `elem` " \t"
+
+----------------------------------------------------------------
+
+parseField :: RawField -> (RawFieldKey,RawFieldValue)
+parseField bs = (k,v')
+  where
+    (k,v) = break' ':' bs
+    -- Sendmail drops ' ' after ':'.
+    v' = if v /= "" && L.head v == ' '
+         then L.tail v
+         else v
+
+----------------------------------------------------------------
+
+{-|
+  Parsing field value of tag=value.
+-}
+-- This breaks spaces in the note tag.
+parseTaggedValue :: RawFieldValue -> [(L.ByteString,L.ByteString)]
+parseTaggedValue xs = vss
+  where
+    v = L.filter (not.isSpace) xs
+    vs = filter (/= "") $ L.split ';' v
+    vss = map (break' '=') vs
diff --git a/Network/DomainAuth/Mail/Types.hs b/Network/DomainAuth/Mail/Types.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/Mail/Types.hs
@@ -0,0 +1,57 @@
+module Network.DomainAuth.Mail.Types where
+
+import qualified Data.ByteString.Lazy.Char8 as L
+import Data.Char
+import Data.Sequence
+
+----------------------------------------------------------------
+-- | Type for raw e-mail message.
+type RawMail = L.ByteString
+type RawHeader = L.ByteString
+type RawBody = L.ByteString
+type RawField = L.ByteString
+-- | Field key for raw e-mail message.
+type RawFieldKey = L.ByteString
+-- | Field value for raw e-mail message.
+type RawFieldValue = L.ByteString
+-- | Body chunk for raw e-mail message.
+type RawBodyChunk = L.ByteString
+
+----------------------------------------------------------------
+
+{-|
+  Type for parsed e-mail message.
+-}
+data Mail = Mail {
+    mailHeader :: Header
+  , mailBody :: Body
+  } deriving (Eq,Show)
+
+{-|
+  Header type for parsed e-mail message.
+-}
+type Header = [Field]
+
+{-|
+  Field type for parsed e-mail message.
+-}
+data Field = Field {
+    fieldSearchKey :: CanonFieldKey
+  , fieldKey       :: FieldKey
+  , fieldValue     :: FieldValue
+  } deriving (Eq,Show)
+
+-- | Type for canonicalized field key of parsed e-mail message.
+type CanonFieldKey = L.ByteString
+-- | Type for field key of parsed e-mail message.
+type FieldKey = L.ByteString
+-- | Type for field value of parsed e-mail message.
+type FieldValue = [L.ByteString]
+-- | Type for body of parsed e-mail message.
+type Body = Seq L.ByteString
+
+----------------------------------------------------------------
+
+-- | Canonicalizing 'FieldKey' for search.
+canonicalizeKey :: FieldKey -> CanonFieldKey
+canonicalizeKey = L.map toLower
diff --git a/Network/DomainAuth/Mail/XMail.hs b/Network/DomainAuth/Mail/XMail.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/Mail/XMail.hs
@@ -0,0 +1,40 @@
+module Network.DomainAuth.Mail.XMail where
+
+import qualified Data.ByteString.Lazy.Char8 as L
+import Data.Sequence (fromList)
+import Network.DomainAuth.Mail.Types
+import Network.DomainAuth.Utils
+
+----------------------------------------------------------------
+
+-- | Type for temporary data to parse e-mail message.
+data XMail = XMail {
+    xmailHeader :: Header
+  , xmailBody :: [RawBodyChunk]
+  } deriving (Eq,Show)
+
+-- | Initial value for 'XMail'.
+initialXMail :: XMail
+initialXMail = XMail [] []
+
+-- | Storing field key and field value to the temporary data.
+pushField :: RawFieldKey -> RawFieldValue -> XMail -> XMail
+pushField key val xmail = xmail {
+    xmailHeader = fld : xmailHeader xmail
+  }
+  where
+    fld = Field ckey key (blines val)
+    ckey = canonicalizeKey key
+
+-- | Storing body chunk to the temporary data.
+pushBody :: RawBodyChunk -> XMail -> XMail
+pushBody bc xmail = xmail {
+    xmailBody = bc : xmailBody xmail
+  }
+
+-- | Converting 'XMail' to 'Mail'.
+finalizeMail :: XMail -> Mail
+finalizeMail xmail = Mail {
+    mailHeader = reverse . xmailHeader $ xmail
+  , mailBody = fromList . blines . L.concat . reverse . xmailBody $ xmail
+  }
diff --git a/Network/DomainAuth/PRD.hs b/Network/DomainAuth/PRD.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/PRD.hs
@@ -0,0 +1,12 @@
+{-|
+  Utilities to decide Purported Responsible Domain (<http://www.ietf.org/rfc/rfc4407>).
+-}
+
+module Network.DomainAuth.PRD (
+    module Network.DomainAuth.PRD.PRD
+  , module Network.DomainAuth.PRD.Domain
+  ) where
+
+import Network.DomainAuth.PRD.PRD
+import Network.DomainAuth.PRD.Domain
+
diff --git a/Network/DomainAuth/PRD/Domain.hs b/Network/DomainAuth/PRD/Domain.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/PRD/Domain.hs
@@ -0,0 +1,17 @@
+module Network.DomainAuth.PRD.Domain (extractDomain) where
+
+import Network.DNS (Domain)
+import Network.DomainAuth.Mail
+import Network.DomainAuth.PRD.Lexer
+import Text.Appar.LazyByteString
+
+{-|
+  Extract a domain from a value of a header field.
+-}
+
+extractDomain :: RawFieldValue -> Maybe Domain
+extractDomain bs = parse structured bs >>= takeDomain
+    where
+      takeDomain = dropTail . dropWhile (/="@")
+      dropTail [] = Nothing
+      dropTail xs = (Just . concat . takeWhile (/=">") . tail) xs
diff --git a/Network/DomainAuth/PRD/Lexer.hs b/Network/DomainAuth/PRD/Lexer.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/PRD/Lexer.hs
@@ -0,0 +1,100 @@
+module Network.DomainAuth.PRD.Lexer (
+    structured
+  ) where
+
+import Control.Applicative
+import Text.Appar.LazyByteString
+
+----------------------------------------------------------------
+
+concatSpace :: [String] -> String
+concatSpace = unwords
+
+----------------------------------------------------------------
+
+skipChar :: Char -> Parser ()
+skipChar c = () <$ char c
+
+wsp :: Parser Char
+wsp = oneOf " \t\n"
+
+----------------------------------------------------------------
+
+structured :: Parser [String]
+structured = removeComments <$> many (choice choices)
+  where
+    removeComments = filter (/="")
+    choices = [specials,quotedString,domainLiteral,atom,comment]
+
+specials :: Parser String
+specials = toStr <$> (specialChar <* skipMany wsp)
+  where
+    -- removing "()[]\\\""
+    specialChar = oneOf "<>:;@=,."
+    toStr c = [c]
+
+----------------------------------------------------------------
+
+atext :: Parser Char
+atext = alphaNum <|> oneOf "!#$%&'*+-/=?^_`{|}~"
+
+atom :: Parser String
+atom = some atext <* skipMany wsp
+
+----------------------------------------------------------------
+
+dtext :: Parser Char
+dtext = oneOf $ ['!' .. 'Z'] ++ ['^' .. '~']
+
+domainLiteral :: Parser String
+domainLiteral = do
+    skipChar '['
+    ds <- many (some dtext <* skipMany wsp)
+    skipChar ']'
+    skipMany wsp
+    return (concatSpace ds)
+
+----------------------------------------------------------------
+
+qtext :: Parser Char
+qtext = oneOf $ "!" ++ ['#' .. '['] ++ [']' .. '~']
+
+qcontent :: Parser Char
+qcontent = qtext <|> quoted_pair
+
+quotedString :: Parser String
+quotedString = do
+    skipChar '"'
+    skipMany wsp
+    qs <- many (some qcontent <* skipMany wsp)
+    skipChar '"'
+    skipMany wsp
+    return (concatSpace qs)
+
+----------------------------------------------------------------
+
+vchar :: Parser Char
+vchar = oneOf ['!'..'~']
+
+quoted_pair :: Parser Char
+quoted_pair = skipChar '\\' >> (vchar <|> wsp)
+
+----------------------------------------------------------------
+
+ctext :: Parser Char
+ctext = oneOf $ ['!' .. '\''] ++ ['*' .. '['] ++ [']' .. '~']
+
+ccontent :: Parser String
+ccontent = some (ctext <|> quoted_pair)
+
+comment' :: Parser String
+comment' = do
+    skipChar '('
+    skipMany wsp
+    cs <- many ((ccontent <|> comment') <* skipMany wsp)
+    skipChar ')'
+    skipMany wsp
+    return (concatSpace cs)
+
+comment :: Parser String
+comment = "" <$ comment'
diff --git a/Network/DomainAuth/PRD/PRD.hs b/Network/DomainAuth/PRD/PRD.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/PRD/PRD.hs
@@ -0,0 +1,132 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+{-|
+  Purported Responsible Domain, RFC 4407.
+-}
+
+module Network.DomainAuth.PRD.PRD (
+    PRD
+  , initialPRD, pushPRD
+  , decidePRD, decideFrom
+  ) where
+
+import Control.Monad
+import qualified Data.ByteString.Lazy.Char8 as L
+import Data.Char
+import Data.List (foldl')
+import Network.DNS (Domain)
+import Network.DomainAuth.Mail
+import Network.DomainAuth.PRD.Domain
+
+----------------------------------------------------------------
+
+type HD = [(CanonFieldKey,RawFieldValue)]
+
+data DST = DST_Zero | DST_Invalid | DST_Valid Domain deriving (Eq, Show)
+
+{-|
+  Abstract type for context to decide PRD(purported responsible domain)
+  according to RFC 4407.
+-}
+data PRD = PRD {
+    praFrom         :: DST
+  , praSender       :: DST
+  , praResentFrom   :: DST
+  , praResentSender :: DST
+  , praHeader       :: HD
+  } deriving Show
+
+{-|
+  Initial context of PRD.
+-}
+initialPRD :: PRD
+initialPRD = PRD {
+    praFrom         = DST_Zero
+  , praSender       = DST_Zero
+  , praResentFrom   = DST_Zero
+  , praResentSender = DST_Zero
+  , praHeader       = []
+  }
+
+----------------------------------------------------------------
+
+{-|
+  Pushing a field key and its value in to the PRD context.
+-}
+pushPRD :: RawFieldKey -> RawFieldValue -> PRD -> PRD
+pushPRD key val ctx = case ckey of
+    "from"          -> pushFrom ctx' jdom
+    "sender"        -> pushSender ctx' jdom
+    "resent-from"   -> pushResentFrom ctx' jdom
+    "resent-sender" -> pushResentSender ctx' jdom
+    _               -> ctx'
+  where
+    ckey = L.map toLower key
+    jdom = extractDomain val
+    ctx' = ctx { praHeader = (ckey,val) : praHeader ctx }
+
+{-|
+  Deciding PRD from the RPD context.
+-}
+decidePRD :: PRD -> Maybe Domain
+decidePRD ctx =
+    let jds = [ praResentSender ctx
+              , praResentFrom ctx
+              , praSender ctx
+              , praFrom ctx
+              ]
+    in foldl' mplus mzero $ map toMaybe jds
+{-|
+  Taking the value of From: from the RPD context.
+-}
+decideFrom :: PRD -> Maybe Domain
+decideFrom = toMaybe . praFrom
+
+toMaybe :: DST -> Maybe String
+toMaybe (DST_Valid d) = Just d
+toMaybe _             = Nothing
+
+----------------------------------------------------------------
+
+pushFrom :: PRD -> Maybe Domain -> PRD
+pushFrom ctx Nothing    = ctx { praFrom = DST_Invalid }
+pushFrom ctx (Just dom) = ctx { praFrom = from }
+  where
+    from = case praFrom ctx of
+        DST_Zero -> DST_Valid dom
+        _        -> DST_Invalid
+
+pushSender :: PRD -> Maybe Domain -> PRD
+pushSender ctx Nothing    = ctx { praSender = DST_Invalid }
+pushSender ctx (Just dom) = ctx { praSender = sender }
+  where
+    sender = case praSender ctx of
+        DST_Zero -> DST_Valid dom
+        _        -> DST_Invalid
+
+pushResentFrom :: PRD -> Maybe Domain -> PRD
+pushResentFrom ctx Nothing    = ctx { praResentFrom = DST_Invalid }
+pushResentFrom ctx (Just dom) = ctx { praResentFrom = rfrom }
+  where
+    rfrom = case praResentFrom ctx of
+        DST_Zero    -> DST_Valid dom
+        DST_Valid d -> DST_Valid d
+        DST_Invalid -> DST_Invalid
+
+pushResentSender :: PRD -> Maybe Domain -> PRD
+pushResentSender ctx Nothing        = ctx { praResentSender = DST_Invalid }
+pushResentSender ctx (Just dom)
+    | praResentFrom ctx == DST_Zero = ctx { praResentSender = rsender }
+    | isFirstBlock (praHeader ctx)  = ctx { praResentSender = DST_Valid dom }
+    | otherwise                     = ctx { praResentSender = DST_Invalid }
+  where
+    rsender = case praResentSender ctx of
+        DST_Zero    -> DST_Valid dom
+        DST_Valid d -> DST_Valid d
+        DST_Invalid -> DST_Invalid
+
+isFirstBlock :: HD -> Bool
+isFirstBlock hdr = all rr . takeWhile end $ hdr
+  where
+    end = (/= "resent-from") . fst
+    rr  = (`notElem` ["received", "return-path"]) . fst
diff --git a/Network/DomainAuth/Pubkey/Base64.hs b/Network/DomainAuth/Pubkey/Base64.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/Pubkey/Base64.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.DomainAuth.Pubkey.Base64 where
+
+import Data.Bits (shiftL, shiftR, (.&.), (.|.))
+import qualified Data.ByteString.Lazy.Char8 as L
+import Data.Char (ord, chr, isAscii, isAlphaNum, isUpper, isLower, isDigit)
+import Network.DomainAuth.Utils
+
+decode :: L.ByteString -> L.ByteString
+decode = dec . L.filter valid
+  where
+    valid c = isAscii c
+              && (isAlphaNum c || (c `elem` "+/="))
+
+dec :: L.ByteString -> L.ByteString
+dec bs
+    | L.null bs             = ""
+    | len == 4 && c3 == '=' = L.take 1 (dec' x1 x2  0  0)
+    | len == 4 && c4 == '=' = L.take 2 (dec' x1 x2 x3  0)
+    | len >= 4              =           dec' x1 x2 x3 x4  +++ dec bs'
+    | otherwise             = error "dec"
+  where
+    len = L.length bs
+    c1 = bs !!! 0
+    c2 = bs !!! 1
+    c3 = bs !!! 2
+    c4 = bs !!! 3
+    x1 = fromChar c1
+    x2 = fromChar c2
+    x3 = fromChar c3
+    x4 = fromChar c4
+    bs' = L.drop 4 bs
+
+dec' :: Int -> Int -> Int -> Int -> L.ByteString
+dec' x1 x2 x3 x4 = L.pack [d1,d2,d3]
+  where
+    d1 = chr  ((x1 `shiftL` 2)           .|. (x2 `shiftR` 4))
+    d2 = chr (((x2 `shiftL` 4) .&. 0xF0) .|. (x3 `shiftR` 2))
+    d3 = chr (((x3 `shiftL` 6) .&. 0xC0) .|. x4)
+
+fromChar :: Char -> Int
+fromChar c
+ | isUpper c = ord c - ord 'A'
+ | isLower c = ord c - ord 'a' + 26
+ | isDigit c = ord c - ord '0' + 52
+ | c == '+'  = 62
+ | c == '/'  = 63
+ | otherwise = error ("fromChar: Can't happen: Bad input: " ++ show c)
+
+splits :: Int -> [a] -> [[a]]
+splits _ [] = []
+splits n xs = case splitAt n xs of
+                  (ys, zs) -> ys:splits n zs
diff --git a/Network/DomainAuth/Pubkey/Der.hs b/Network/DomainAuth/Pubkey/Der.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/Pubkey/Der.hs
@@ -0,0 +1,178 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.DomainAuth.Pubkey.Der (
+    decode
+  , Class (..)
+  , TLV (..)
+  ) where
+
+import Control.Applicative hiding (many)
+import Control.Monad
+import Data.Binary.Get
+import Data.Bits
+import qualified Data.ByteString.Lazy.Char8 as L
+
+----------------------------------------------------------------
+
+data TLV = Term
+         | Prim { cls :: Class
+                , tag :: Tag
+                , siz :: Size
+                , cnt :: L.ByteString
+                }
+         | Cons { cls :: Class
+                , tag :: Tag
+                , siz :: Size
+                , tlv :: [TLV]
+                }
+         deriving Show
+
+data Class = Univ | Appl | Cont | Priv deriving (Show, Eq, Enum)
+type Tag  = Int
+type Size = Int
+
+----------------------------------------------------------------
+
+decode :: L.ByteString -> TLV
+decode = runGet der
+
+----------------------------------------------------------------
+
+der :: Get TLV
+der = do
+    first <- nonZero
+    let clss = getClass first
+        cons = getConstructor first
+    tg <- getTag first
+    len <- singleLength
+    if cons
+       then construct clss tg len
+       else primitive clss tg len
+
+primitive :: Class -> Tag -> Int -> Get TLV
+primitive clss tg len = Prim clss tg len <$> getLazyByteString (fromIntegral len)
+
+construct :: Class -> Tag -> Int -> Get TLV
+construct = definite
+    {-
+    if len == indefiniteMark
+    then indefinite clss tg len
+    else definite clss tg len
+    -}
+
+definite :: Class -> Tag -> Int -> Get TLV
+definite clss tg len = do
+    start <- fromIntegral <$> bytesRead
+    let end = start + len
+    Cons clss tg len <$> withinLimit end []
+  where
+    withinLimit end ps = do
+        p <- der
+        end2 <- fromIntegral <$> bytesRead -- xxx
+        if end2 == end
+           then return (ps ++ [p])
+           else withinLimit end (ps ++ [p])
+
+{-
+terminate :: Get TLV
+terminate = Term <$ (zer0 >> zer0)
+
+indefinite :: Class -> Tag -> Int -> Get TLV
+indefinite clss tg len = Cons clss tg len <$> (many der <* terminate)
+-}
+
+getClass :: Int -> Class
+getClass first = toEnum (shift (first .&. classMask) (- classShift)) :: Class
+
+getConstructor :: Int -> Bool
+getConstructor first = first .&. consFlag == consFlag
+
+getTag :: Int -> Get Int
+getTag first = if tg == tagMask
+               then multiTag 0
+               else return tg
+  where
+    tg = first .&. tagMask
+
+multiTag :: Int -> Get Int
+multiTag len = do
+    i <- anyInt
+    if (i .&. tagEnd) == 0
+       then return (incTag len i)
+       else multiTag (incTag len i)
+
+incTag :: Int -> Int -> Int
+incTag len i = len * 128 + (i .&. tagLenMask)
+
+singleLength :: Get Int
+singleLength = do
+    second <- anyInt
+    let multi = getMulti second
+        len = getLen second
+    if multi
+       then definiteLength len
+       else return len
+
+getMulti :: Int -> Bool
+getMulti second = second .&. lenFlag == lenFlag
+
+getLen :: Int -> Int
+getLen second = second .&. lenMask
+
+definiteLength :: Int -> Get Int
+definiteLength bytes = if bytes == 0
+                       then return indefiniteMark
+                       else multiLength 0 bytes
+
+multiLength :: Int -> Int -> Get Int
+multiLength len bytes = do
+    i <- anyInt
+    if bytes == 1
+       then return (incLen len i)
+       else multiLength (incLen len i) (bytes - 1)
+
+incLen :: Int -> Int -> Int
+incLen len i = len * 256 + i
+
+----------------------------------------------------------------
+
+anyInt :: Get Int
+anyInt = fromIntegral <$> getWord8
+
+nonZero :: Get Int
+nonZero = do
+    n <- anyInt
+    when (n == 0) (error "nonZero")
+    return n
+
+{-
+zer0 :: Get Int
+zer0 = do
+    n <- anyInt
+    when (n /= 0) (error "zer0")
+    return n
+-}
+
+----------------------------------------------------------------
+
+classMask :: Int
+classMask  = 0xc0
+classShift :: Int
+classShift = 6
+consFlag :: Int
+consFlag   = 0x20
+
+tagMask :: Int
+tagMask    = 0x1f
+tagEnd :: Int
+tagEnd     = 0x80
+tagLenMask :: Int
+tagLenMask = 0x7f
+
+lenFlag :: Int
+lenFlag    = 0x80
+lenMask :: Int
+lenMask    = 0x7f
+
+indefiniteMark :: Int
+indefiniteMark = -1 -- xxx
diff --git a/Network/DomainAuth/Pubkey/RSAPub.hs b/Network/DomainAuth/Pubkey/RSAPub.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/Pubkey/RSAPub.hs
@@ -0,0 +1,37 @@
+module Network.DomainAuth.Pubkey.RSAPub where
+
+import Codec.Crypto.RSA
+import Control.Applicative
+import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Lazy.Char8 as LC (pack)
+import Network.DNS (Domain)
+import qualified Network.DNS as DNS hiding (Domain)
+import Network.DomainAuth.Mail
+import qualified Network.DomainAuth.Pubkey.Base64 as B
+import qualified Network.DomainAuth.Pubkey.Der as D
+
+lookupPublicKey :: DNS.Resolver -> Domain -> IO (Maybe PublicKey)
+lookupPublicKey resolver domain = decode <$> lookupPublicKey' resolver domain
+  where
+    decode = (>>= return . decodeRSAPublicyKey)
+
+lookupPublicKey' :: DNS.Resolver -> String -> IO (Maybe L.ByteString)
+lookupPublicKey' resolver domain = extractPub <$> DNS.lookupTXT resolver domain
+
+extractPub :: Maybe [L.ByteString] -> Maybe L.ByteString
+extractPub = (>>= lookup (LC.pack "p") . parseTaggedValue . head)
+
+decodeRSAPublicyKey :: L.ByteString -> PublicKey
+decodeRSAPublicyKey bs = PublicKey size n e
+  where
+    subjectPublicKeyInfo = D.decode . B.decode $ bs
+    [_, subjectPublicKey] = D.tlv subjectPublicKeyInfo
+    rsaPublicKey = D.decode . bitString . D.cnt $ subjectPublicKey
+    [bn',be'] = D.tlv rsaPublicKey
+    bn = L.dropWhile (== 0) $ D.cnt bn'
+    be = D.cnt be'
+    n = toNum bn
+    e = toNum be
+    size = fromIntegral . L.length $ bn
+    toNum = L.foldl' (\x y -> x*256 + fromIntegral y) 0
+    bitString = L.tail
diff --git a/Network/DomainAuth/SPF.hs b/Network/DomainAuth/SPF.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/SPF.hs
@@ -0,0 +1,33 @@
+{-|
+ A library for SPF(<http://www.ietf.org/rfc/rfc4408>)
+ and Sender-ID(<http://www.ietf.org/rfc/rfc4406>).
+-}
+module Network.DomainAuth.SPF (
+    runSPF
+  , Limit(..)
+  , defaultLimit
+  ) where
+
+import Data.IP
+import Network.DNS (Domain, Resolver)
+import Network.DomainAuth.Types
+import Network.DomainAuth.SPF.Eval
+import Network.DomainAuth.SPF.Resolver
+import System.IO.Error
+
+{-|
+  Process SPF authentication. 'IP' is an IP address of an SMTP peer.
+  If 'Domain' is specified from SMTP MAIL FROM, authentication is
+  based on SPF. If 'Domain' is specified from the From field of mail
+  header, authentication is based on SenderID. If condition reaches
+  'Limit', 'SpfPermError' is returned.
+-}
+runSPF :: Limit -> Resolver -> Domain -> IP -> IO DAResult
+runSPF lim resolver dom ip =
+    (resolveSPF resolver dom ip >>= evalSPF lim ip) `catch` spfErrorHandle
+
+spfErrorHandle :: IOError -> IO DAResult
+spfErrorHandle e = case ioeGetErrorString e of
+                     "TempError" -> return DATempError
+                     "PermError" -> return DAPermError
+                     _           -> return DANone
diff --git a/Network/DomainAuth/SPF/Eval.hs b/Network/DomainAuth/SPF/Eval.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/SPF/Eval.hs
@@ -0,0 +1,101 @@
+module Network.DomainAuth.SPF.Eval (evalSPF, Limit(..), defaultLimit) where
+
+import Control.Applicative
+import Data.IORef
+import Data.IP
+import Data.Maybe
+import Network.DomainAuth.SPF.Types
+import Network.DomainAuth.Types
+
+{-|
+  Limit for SPF authentication.
+-}
+data Limit = Limit {
+    -- | How many \"redirect\"/\"include\" should be followed.
+    limit :: Int
+    -- | Ignoring IPv4 range whose mask length is shorter than this.
+  , ipv4_masklen :: Int
+    -- | Ignoring IPv6 range whose mask length is shorter than this.
+  , ipv6_masklen :: Int
+    -- | Whether or not \"+all\" is rejected.
+  , reject_plus_all :: Bool
+  }
+
+{-|
+  Default 'Limit'. 'limit' is 10. 'ipv4_masklen' is 16.
+  'ipv6_masklen' is 48. 'reject_plus_all' is 'True'.
+-}
+defaultLimit :: Limit
+defaultLimit = Limit {
+    limit = 10
+  , ipv4_masklen = 16
+  , ipv6_masklen = 48
+  , reject_plus_all = True
+  }
+
+----------------------------------------------------------------
+
+evalSPF :: Limit -> IP -> [IO SpfSeq] -> IO DAResult
+evalSPF lim ip ss = do
+    ref <- newIORef (0 :: Int)
+    fromJust <$> evalspf ref lim ip ss
+
+----------------------------------------------------------------
+
+evalspf :: IORef Int -> Limit -> IP -> [IO SpfSeq] -> IO (Maybe DAResult)
+evalspf _ _ _ [] = return (Just DANeutral) -- default result
+evalspf ref lim ip (s:ss) = do
+    cnt <- readIORef ref
+    if cnt > limit lim
+       then return (Just DAPermError) -- reached the limit
+       else do
+           mres <- eval ref lim ip s
+           case mres of
+               Nothing  -> evalspf ref lim ip ss
+               res      -> return res
+
+----------------------------------------------------------------
+{-
+Follow N of redirect/include. But the last one is not
+evaluated.
+-}
+
+eval :: IORef Int -> Limit -> IP -> IO SpfSeq -> IO (Maybe DAResult)
+eval ref lim ip is = do
+    cnt <- readIORef ref
+    s <- is
+    case s of
+      SS_All q -> if q == Q_Pass && reject_plus_all lim
+                  then result DAPermError
+                  else ret q
+      SS_IPv4Range q ipr
+           | nastyMask4 lim ipr        -> result DAPermError
+           | ipv4 ip `isMatchedTo` ipr -> ret q
+           | otherwise                 -> continue
+      SS_IPv4Ranges q iprs
+           | any (nastyMask4 lim) iprs        -> result DAPermError
+           | any (ipv4 ip `isMatchedTo`) iprs -> ret q
+           | otherwise                        -> continue
+      SS_IPv6Range q ipr
+           | nastyMask6 lim ipr        -> result DAPermError
+           | ipv6 ip `isMatchedTo` ipr -> ret q
+           | otherwise                 -> continue
+      SS_IPv6Ranges q iprs
+           | any (nastyMask6 lim) iprs        -> result DAPermError
+           | any (ipv6 ip `isMatchedTo`) iprs -> ret q
+           | otherwise                        -> continue
+      SS_IF_Pass q ss -> do
+          writeIORef ref (cnt + 1)
+          r <- evalspf ref lim ip ss
+          if r == Just DAPass
+            then ret q
+            else continue
+      SS_SpfSeq ss -> do
+          writeIORef ref (cnt + 1)
+          evalspf ref lim ip ss
+  where
+    ret = return . Just . toEnum . fromEnum
+    result = return . Just
+    continue = return Nothing
+    nastyMask4 st ipr = mlen ipr < ipv4_masklen st
+    nastyMask6 st ipr = mlen ipr < ipv6_masklen st
diff --git a/Network/DomainAuth/SPF/Parser.hs b/Network/DomainAuth/SPF/Parser.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/SPF/Parser.hs
@@ -0,0 +1,97 @@
+module Network.DomainAuth.SPF.Parser (parseSPF) where
+
+import Control.Applicative
+import qualified Data.ByteString.Lazy.Char8 as L
+import Network.DNS (Domain)
+import Network.DomainAuth.SPF.Types
+import Prelude hiding (all)
+import Text.Appar.LazyByteString
+
+----------------------------------------------------------------
+
+parseSPF :: L.ByteString  -> Maybe [SPF]
+parseSPF = parse spf
+
+----------------------------------------------------------------
+
+spaces1 :: Parser ()
+spaces1 = skipSome space
+
+----------------------------------------------------------------
+
+spf :: Parser [SPF]
+spf = do spfPrefix
+         some $ do spaces1
+                    -- modifier should be first since + is optional
+                   modifier <|> directive
+
+spfPrefix :: Parser ()
+spfPrefix = () <$ string "v=spf1"
+
+----------------------------------------------------------------
+
+modifier :: Parser SPF
+modifier = SPF_Redirect <$> (string "redirect=" *> domain)
+
+directive :: Parser SPF
+directive = qualifier >>= mechanism
+
+----------------------------------------------------------------
+
+qualifier :: Parser Qualifier
+qualifier = option Q_Pass (choice quals)
+    where
+      func sym res = res <$ char sym
+      quals = zipWith func qualifierSymbol [minBound..maxBound]
+
+----------------------------------------------------------------
+
+type Directive = Qualifier -> Parser SPF
+
+mechanism :: Directive
+mechanism q = choice $ map ($ q) [ip4,ip6,all,address,mx,include]
+
+ip4 :: Directive
+ip4 q = try $ SPF_IPv4Range q . read <$> (string "ip4:" *> some (noneOf " "))
+
+ip6 :: Directive
+ip6 q = try $ SPF_IPv6Range q . read <$> (string "ip6:" *> some (noneOf " "))
+
+all :: Directive
+all q = try $ SPF_All q <$ string "all"
+
+address :: Directive
+address q = SPF_Address q <$> (string "a" *> optionalDomain)
+                          <*> optionalMask
+
+mx :: Directive
+mx q = SPF_MX q <$> (string "mx" *> optionalDomain)
+                <*> optionalMask
+
+include :: Directive
+include q = SPF_Include q <$> (string "include:" *> domain)
+
+----------------------------------------------------------------
+
+domain :: Parser String
+domain = some (oneOf $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "_-.")
+
+optionalDomain :: Parser (Maybe Domain)
+optionalDomain = option Nothing (Just <$> (char ':' *> domain))
+
+mask :: Parser Int
+mask = read <$> (some . oneOf $ ['0'..'9'])
+
+optionalMask :: Parser (Int,Int)
+optionalMask = try both <|> try v4 <|> try v6 <|> none
+  where
+    both = (,) <$> ipv4Mask <*> ipv6Mask
+    v4   = ipv4Mask >>= \l4 -> return (l4,128)
+    v6   = ipv6Mask >>= \l6 -> return (32,l6)
+    none = return (32,128)
+
+ipv4Mask :: Parser Int
+ipv4Mask = char '/' *> mask
+
+ipv6Mask :: Parser Int
+ipv6Mask = string "//" *> mask
diff --git a/Network/DomainAuth/SPF/Resolver.hs b/Network/DomainAuth/SPF/Resolver.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/SPF/Resolver.hs
@@ -0,0 +1,89 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.DomainAuth.SPF.Resolver (resolveSPF) where
+
+import Control.Applicative
+import Control.Monad
+import Data.IP
+import qualified Data.ByteString.Lazy.Char8 as L
+import Data.Maybe
+import Network.DNS
+import Network.DomainAuth.SPF.Parser
+import Network.DomainAuth.SPF.Types
+
+----------------------------------------------------------------
+
+resolveSPF :: Resolver -> Domain -> IP -> IO [IO SpfSeq]
+resolveSPF resolver dom ip = do
+    jrc <- lookupTXT resolver dom
+    checkDNS jrc "TempError"
+    let rr = getSPFRR jrc
+    checkExistence rr "None"
+    let jrs = parseSPF rr
+    checkSyntax jrs "PermError"
+    let is = filterSPFWithIP ip (fromJust jrs)
+    return $ map (toSpfSeq resolver dom ip) is
+  where
+    getSPFRR jrc = let ts = filter ("v=spf1" `L.isPrefixOf`) (fromJust jrc)
+                   in if null ts then "" else head ts
+    checkSyntax rs estr = when (isNothing rs) (fail estr)
+    checkExistence rr estr = when (L.null rr) (fail estr)
+
+----------------------------------------------------------------
+
+filterSPFWithIP :: IP -> [SPF] -> [SPF]
+filterSPFWithIP (IPv4 _) spfs = filter exceptIPv4 spfs
+filterSPFWithIP (IPv6 _) spfs = filter exceptIPv6 spfs
+
+exceptIPv4 :: SPF -> Bool
+exceptIPv4 (SPF_IPv6Range _ _) = False
+exceptIPv4 _                   = True
+
+exceptIPv6 :: SPF -> Bool
+exceptIPv6 (SPF_IPv4Range _ _) = False
+exceptIPv6 _                   = True
+
+----------------------------------------------------------------
+
+toSpfSeq :: Resolver -> Domain -> IP -> SPF -> IO SpfSeq
+toSpfSeq _ _ _  (SPF_IPv4Range q ipr) = return $ SS_IPv4Range q ipr
+toSpfSeq _ _ _  (SPF_IPv6Range q ipr) = return $ SS_IPv6Range q ipr
+toSpfSeq _ _ _  (SPF_All       q)     = return $ SS_All q
+toSpfSeq r _ ip (SPF_Include   q dom) = SS_IF_Pass q <$> resolveSPF r dom ip
+toSpfSeq r _ ip (SPF_Redirect dom)    = SS_SpfSeq <$> resolveSPF r dom ip
+
+toSpfSeq r dom (IPv4 _) (SPF_MX q Nothing (l4,_))
+    = lookupAviaMX r dom    >>= doit4 q l4
+toSpfSeq r dom (IPv6 _) (SPF_MX q Nothing (_,l6))
+    = lookupAAAAviaMX r dom >>= doit6 q l6
+toSpfSeq r _   (IPv4 _) (SPF_MX q (Just dom) (l4,_))
+    = lookupAviaMX r dom    >>= doit4 q l4
+toSpfSeq r _   (IPv6 _) (SPF_MX q (Just dom) (_,l6))
+    = lookupAAAAviaMX r dom >>= doit6 q l6
+toSpfSeq r dom (IPv4 _) (SPF_Address q Nothing (l4,_))
+    = lookupA r dom    >>= doit4 q l4
+toSpfSeq r dom (IPv6 _) (SPF_Address q Nothing (_,l6))
+    = lookupAAAA r dom >>= doit6 q l6
+toSpfSeq r _   (IPv4 _) (SPF_Address q (Just dom) (l4,_))
+    = lookupA r dom    >>= doit4 q l4
+toSpfSeq r _   (IPv6 _) (SPF_Address q (Just dom) (_,l6))
+    = lookupAAAA r dom >>= doit6 q l6
+
+doit4 :: Qualifier -> Int -> Maybe [IPv4] -> IO SpfSeq
+doit4 q l4 is = do
+    checkDNS is "TempError"
+    return $ SS_IPv4Ranges q $ map (mkr l4) $ fromJust is
+  where
+    mkr = flip makeAddrRange
+
+doit6 :: Qualifier -> Int -> Maybe [IPv6] -> IO SpfSeq
+doit6 q l6 is = do
+    checkDNS is "TempError"
+    return $ SS_IPv6Ranges q $ map (mkr l6) $ fromJust is
+  where
+    mkr = flip makeAddrRange
+
+----------------------------------------------------------------
+
+checkDNS :: Maybe a -> String -> IO ()
+checkDNS jrc estr = when (isNothing jrc) (fail estr)
diff --git a/Network/DomainAuth/SPF/Types.hs b/Network/DomainAuth/SPF/Types.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/SPF/Types.hs
@@ -0,0 +1,33 @@
+module Network.DomainAuth.SPF.Types where
+
+import Data.IP
+import Network.DNS (Domain)
+
+----------------------------------------------------------------
+
+-- See DAResult in Network.DomainAuth.Types
+data Qualifier = Q_Pass | Q_HardFail | Q_Softfail | Q_Neutral
+                 deriving (Eq,Enum,Bounded,Show)
+
+-- Depends on Qualifier
+qualifierSymbol :: String
+qualifierSymbol = "+-~?"
+
+data SPF = SPF_IPv4Range Qualifier (AddrRange IPv4)
+         | SPF_IPv6Range Qualifier (AddrRange IPv6)
+         | SPF_Address   Qualifier (Maybe Domain) (Int,Int)
+         | SPF_MX        Qualifier (Maybe Domain) (Int,Int)
+         | SPF_Include   Qualifier Domain
+         | SPF_All       Qualifier
+         | SPF_Redirect            Domain
+           deriving Show
+
+----------------------------------------------------------------
+
+data SpfSeq = SS_All        Qualifier
+            | SS_IPv4Range  Qualifier (AddrRange IPv4)
+            | SS_IPv6Range  Qualifier (AddrRange IPv6)
+            | SS_IPv4Ranges Qualifier [AddrRange IPv4]
+            | SS_IPv6Ranges Qualifier [AddrRange IPv6]
+            | SS_IF_Pass    Qualifier [IO SpfSeq]
+            | SS_SpfSeq               [IO SpfSeq]
diff --git a/Network/DomainAuth/Types.hs b/Network/DomainAuth/Types.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/Types.hs
@@ -0,0 +1,40 @@
+{-|
+  Type for Message Authentication Status (<http://www.ietf.org/rfc/rfc5451.txt>).
+-}
+
+module Network.DomainAuth.Types where
+
+----------------------------------------------------------------
+
+{-|
+  The result of domain authentication. For more information, see
+  <http://www.ietf.org/rfc/rfc5451.txt>.
+-}
+-- See Qualifier in Network.DomainAuth.SPF.Types
+data DAResult = DAPass
+              | DAHardFail
+              | DASoftFail
+              | DANeutral
+              | DAFail
+              | DATempError
+              | DAPermError
+              | DANone
+              | DAPolicy
+              | DANxDomain
+              | DADiscard
+              | DAUnknown
+              deriving (Eq,Enum,Bounded)
+
+instance Show DAResult where
+    show DAPass       = "pass"
+    show DAHardFail   = "hardfail"
+    show DASoftFail   = "fail"
+    show DANeutral    = "neutral"
+    show DAFail       = "fail"
+    show DATempError  = "temperror"
+    show DAPermError  = "permerror"
+    show DANone       = "none"
+    show DAPolicy     = "policy"
+    show DANxDomain   = "nxdomain"
+    show DADiscard    = "discard"
+    show DAUnknown    = "unknown"
diff --git a/Network/DomainAuth/Utils.hs b/Network/DomainAuth/Utils.hs
new file mode 100644
--- /dev/null
+++ b/Network/DomainAuth/Utils.hs
@@ -0,0 +1,100 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.DomainAuth.Utils where
+
+import qualified Data.ByteString.Lazy.Char8 as L
+import Data.Char
+import Data.Int
+
+crlf :: L.ByteString
+crlf = "\r\n"
+
+(+++) :: L.ByteString -> L.ByteString -> L.ByteString
+(+++) = L.append
+
+(!!!) :: L.ByteString -> Int64 -> Char
+(!!!) = L.index
+
+----------------------------------------------------------------
+
+appendCRLF :: L.ByteString -> L.ByteString -> L.ByteString
+appendCRLF x y = x +++ crlf +++ y
+
+appendCRLFWith :: (a -> L.ByteString) -> a -> L.ByteString -> L.ByteString
+appendCRLFWith modify x y = modify x +++ crlf +++ y
+
+concatCRLF :: [L.ByteString] -> L.ByteString
+concatCRLF = foldr appendCRLF ""
+
+concatCRLFWith :: (a -> L.ByteString) -> [a] -> L.ByteString
+concatCRLFWith modify = foldr (appendCRLFWith modify) ""
+
+----------------------------------------------------------------
+
+{-|
+  Replaces multiple WPSs to a single SP.
+-}
+reduceWSP :: Cook
+reduceWSP "" = ""
+reduceWSP bs
+  | isSpace (L.head bs) = inSP bs
+  | otherwise           = outSP bs
+
+inSP :: Cook
+inSP "" = ""
+inSP bs = " " +++ outSP bs'
+  where
+    (_,bs') = L.span isSpace bs
+
+outSP :: Cook
+outSP "" = ""
+outSP bs = nonSP +++ inSP bs'
+  where
+    (nonSP,bs') = L.break isSpace bs
+
+----------------------------------------------------------------
+
+type FWSRemover = L.ByteString -> L.ByteString
+
+removeFWS :: FWSRemover
+removeFWS = L.filter (not.isSpace)
+
+----------------------------------------------------------------
+
+type Cook = L.ByteString -> L.ByteString
+
+removeTrailingWSP :: Cook
+removeTrailingWSP bs
+  | slowPath  = L.reverse . L.dropWhile isSpace . L.reverse $ bs  -- xxx
+  | otherwise = bs
+  where
+    slowPath = hasTrailingWSP bs
+
+hasTrailingWSP :: L.ByteString -> Bool
+hasTrailingWSP bs
+    | len == 0  = False
+    | otherwise = isSpace lastChar
+  where
+    len = L.length bs
+    lastChar = bs !!! (len - 1)
+
+----------------------------------------------------------------
+
+chop :: L.ByteString -> L.ByteString
+chop "" = ""
+chop bs
+  | L.last bs == '\r' = L.init bs
+  | otherwise         = bs
+
+blines :: L.ByteString -> [L.ByteString]
+blines = map chop . L.lines
+
+----------------------------------------------------------------
+
+break' :: Char -> L.ByteString -> (L.ByteString,L.ByteString)
+break' c bs = (f,s)
+  where
+    (f,s') = L.break (==c) bs
+    s = if s' == ""
+        then ""
+        else L.tail s'
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/domain-auth.cabal b/domain-auth.cabal
new file mode 100644
--- /dev/null
+++ b/domain-auth.cabal
@@ -0,0 +1,53 @@
+Name:                   domain-auth
+Version:                0.1.0
+Author:                 Kazu Yamamoto <kazu@iij.ad.jp>
+Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp>
+License:                BSD3
+License-File:           LICENSE
+Synopsis:               Domain authentication library
+Description:            Library for Sender Policy Framework, SenderID,
+                        DomainKeys and DKIM.
+Category:               Network
+Cabal-Version:          >= 1.6
+Build-Type:             Simple
+library
+  if impl(ghc >= 6.12)
+    GHC-Options:        -Wall -fno-warn-unused-do-bind
+  else
+    GHC-Options:        -Wall
+  Exposed-Modules:      Network.DomainAuth
+                        Network.DomainAuth.Mail
+                        Network.DomainAuth.DK
+                        Network.DomainAuth.DKIM
+                        Network.DomainAuth.SPF
+                        Network.DomainAuth.PRD
+                        Network.DomainAuth.Types
+  Other-Modules:        Network.DomainAuth.Utils
+                        Network.DomainAuth.Mail.Mail
+                        Network.DomainAuth.Mail.Parser
+                        Network.DomainAuth.Mail.Types
+                        Network.DomainAuth.Mail.XMail
+                        Network.DomainAuth.DK.Parser
+                        Network.DomainAuth.DK.Types
+                        Network.DomainAuth.DK.Verify
+                        Network.DomainAuth.DKIM.Btag
+                        Network.DomainAuth.DKIM.Parser
+                        Network.DomainAuth.DKIM.Types
+                        Network.DomainAuth.DKIM.Verify
+                        Network.DomainAuth.Pubkey.Base64
+                        Network.DomainAuth.Pubkey.Der
+                        Network.DomainAuth.Pubkey.RSAPub
+                        Network.DomainAuth.PRD.Domain
+                        Network.DomainAuth.PRD.Lexer
+                        Network.DomainAuth.PRD.PRD
+                        Network.DomainAuth.SPF.Eval
+                        Network.DomainAuth.SPF.Parser
+                        Network.DomainAuth.SPF.Resolver
+                        Network.DomainAuth.SPF.Types
+  Build-Depends:        base >= 4 && < 5, appar, dns, iproute,
+                        network, bytestring, RSA, binary,
+                        containers, SHA
+Source-Repository head
+  Type:                 git
+  Location:             git://github.com/kazu-yamamoto/domain-auth.git
+