-- | A library for SPF(<http://www.ietf.org/rfc/rfc4408.txt>)
--   and Sender-ID(<http://www.ietf.org/rfc/rfc4406.txt>).
module Network.DomainAuth.SPF (
    runSPF,
    Limit (..),
    defaultLimit,
) where

import Control.Exception as E
import Data.IP
import Network.DNS (Domain, Resolver)
import Network.DomainAuth.SPF.Eval
import Network.DomainAuth.SPF.Resolver
import Network.DomainAuth.Types
import System.IO.Error

-- $setup
-- >>> import Network.DNS

-- | 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.
--
-- >>> rs <- makeResolvSeed defaultResolvConf
--
-- pass (IPv4 & IPv6):
--
-- >>> withResolver rs $ \rslv -> runSPF defaultLimit rslv "mew.org" "202.238.220.92"
-- pass
-- >>> withResolver rs $ \rslv -> runSPF defaultLimit rslv "iij.ad.jp" "2001:240:bb5f:86c::1:41"
-- pass
--
-- hardfail:
--
-- >>> withResolver rs $ \rslv -> runSPF defaultLimit rslv "example.org" "192.0.2.1"
-- hardfail
--
-- redirect and include:
--
-- >>> withResolver rs $ \rslv -> runSPF defaultLimit rslv "gmail.com" "72.14.192.1"
-- pass
-- >>> withResolver rs $ \rslv -> runSPF defaultLimit rslv "gmail.com" "72.14.128.1"
-- softfail
--
-- limit:
--
-- >>> let limit1 = defaultLimit { ipv4_masklen = 24 }
-- >>> withResolver rs $ \rslv -> runSPF limit1 rslv "gmail.com" "72.14.192.1"
-- softfail
runSPF :: Limit -> Resolver -> Domain -> IP -> IO DAResult
runSPF :: Limit -> Resolver -> Domain -> IP -> IO DAResult
runSPF Limit
lim Resolver
resolver Domain
dom IP
ip =
    (Resolver -> Domain -> IP -> IO [IO SpfSeq]
resolveSPF Resolver
resolver Domain
dom IP
ip IO [IO SpfSeq] -> ([IO SpfSeq] -> IO DAResult) -> IO DAResult
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Limit -> IP -> [IO SpfSeq] -> IO DAResult
evalSPF Limit
lim IP
ip) IO DAResult -> (IOError -> IO DAResult) -> IO DAResult
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` IOError -> IO DAResult
spfErrorHandle

spfErrorHandle :: IOError -> IO DAResult
spfErrorHandle :: IOError -> IO DAResult
spfErrorHandle IOError
e = case IOError -> String
ioeGetErrorString IOError
e of
    String
"TempError" -> DAResult -> IO DAResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DAResult
DATempError
    String
"PermError" -> DAResult -> IO DAResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DAResult
DAPermError
    String
_ -> DAResult -> IO DAResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DAResult
DANone