{-# LANGUAGE OverloadedStrings #-}

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

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

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