{-# 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
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