{-# LANGUAGE OverloadedStrings #-}

module Network.DomainAuth.PRD.Domain (
    extractDomain
  ) where

import Network.DNS (Domain)
import Network.DomainAuth.Mail
import Network.DomainAuth.PRD.Lexer
import qualified Data.Attoparsec.ByteString as P
import qualified Data.ByteString.Char8 as BS

-- | Extract a domain from a value of a header field.
--
-- >>> extractDomain "Alice Brown <alice.brown@example.com>"
-- Just "example.com"
-- >>> extractDomain "\"Alice . Brown\" <alice.brown@example.com> (Nickname here)"
-- Just "example.com"
-- >>> extractDomain "alice.brown@example.com"
-- Just "example.com"
-- >>> extractDomain "Alice Brown <example.com>"
-- Nothing

extractDomain :: RawFieldValue -> Maybe Domain
extractDomain :: RawFieldValue -> Maybe RawFieldValue
extractDomain RawFieldValue
bs = case forall a. Parser a -> RawFieldValue -> Either String a
P.parseOnly Parser [RawFieldValue]
structured RawFieldValue
bs of
  Left String
_   -> forall a. Maybe a
Nothing
  Right [RawFieldValue]
st -> [RawFieldValue] -> Maybe RawFieldValue
takeDomain [RawFieldValue]
st
    where
      takeDomain :: [RawFieldValue] -> Maybe RawFieldValue
takeDomain = [RawFieldValue] -> Maybe RawFieldValue
dropTail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/=RawFieldValue
"@")
      dropTail :: [RawFieldValue] -> Maybe RawFieldValue
dropTail [] = forall a. Maybe a
Nothing
      dropTail [RawFieldValue]
xs = (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RawFieldValue] -> RawFieldValue
BS.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/=RawFieldValue
">") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
tail) [RawFieldValue]
xs