    {-# LANGUAGE OverloadedStrings #-}
    module Network.PublicSuffixList.Lookup (effectiveTLDPlusOne, effectiveTLDPlusOne', isSuffix, isSuffix') where

    import qualified Data.Map          as M
    import           Data.Maybe (isNothing)
    import qualified Data.Text         as T

    import qualified Network.PublicSuffixList.DataStructure as DS
    import           Network.PublicSuffixList.Types

    {-|
    OffEnd's Bool argument represents whether we fell off a
    leaf or whether we fell off a non-leaf. True means that
    we fell off a leaf. Its Text argument is the component
    that pushed us off the end, along with all the components
    to the right of that one, interspersed with "."s
    -}
    data LookupResult = Inside | AtLeaf | OffEnd Bool T.Text
      deriving (LookupResult -> LookupResult -> Bool
    (LookupResult -> LookupResult -> Bool)
    -> (LookupResult -> LookupResult -> Bool) -> Eq LookupResult
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: LookupResult -> LookupResult -> Bool
    == :: LookupResult -> LookupResult -> Bool
    $c/= :: LookupResult -> LookupResult -> Bool
    /= :: LookupResult -> LookupResult -> Bool
    Eq)

    {-|
    This function returns whether or not this domain is owned by a
    registrar or a regular person. 'Nothing' means that this is a registrar
    domain; 'Just x' means it's owned by a person. This is used to determine
    if a cookie is allowed to bet set for a particular domain. For
    example, you shouldn't be able to set a cookie for \"com\".

    If the value is 'Just x', then the x value is what is known as the
    effective TLD plus one. This is one segment more than the suffix of the
    domain. For example, the eTLD+1 for "this.is.a.subdom.com" is Just
    "subdom.com"

    Note that this function expects lowercase ASCII strings. These strings
    should be gotten from the toASCII algorithm as described in RFC 3490.
    These strings should not start or end with the \'.\' character, and should
    not have two \'.\' characters next to each other.
    (The toASCII algorithm is implemented in the \'idna\' hackage package,
    though that package doesn't always map strings to lowercase)
    -}
    effectiveTLDPlusOne' :: DataStructure -> T.Text -> Maybe T.Text
    effectiveTLDPlusOne' :: DataStructure -> Text -> Maybe Text
    effectiveTLDPlusOne' DataStructure
    dataStructure Text
    s
      -- Any TLD is a suffix
      | [Text] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Text]
    ss Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1 = Maybe Text
    forall a. Maybe a
    Nothing
      | Bool
    otherwise = LookupResult -> LookupResult -> Maybe Text
    output LookupResult
    rulesResult LookupResult
    exceptionResult
      where ss :: [Text]
    ss = HasCallStack => Text -> Text -> [Text]
    Text -> Text -> [Text]
    T.splitOn Text
    "." Text
    s
            ps :: [Text]
    ps = [Text] -> [Text]
    forall a. [a] -> [a]
    reverse [Text]
    ss
            exceptionResult :: LookupResult
    exceptionResult = [Text] -> [Text] -> Tree Text -> LookupResult
    recurse [Text]
    ps [] (Tree Text -> LookupResult) -> Tree Text -> LookupResult
    forall a b. (a -> b) -> a -> b
    $ DataStructure -> Tree Text
    forall a b. (a, b) -> b
    snd DataStructure
    dataStructure
            rulesResult :: LookupResult
    rulesResult = [Text] -> [Text] -> Tree Text -> LookupResult
    recurse [Text]
    ps [] (Tree Text -> LookupResult) -> Tree Text -> LookupResult
    forall a b. (a -> b) -> a -> b
    $ DataStructure -> Tree Text
    forall a b. (a, b) -> a
    fst DataStructure
    dataStructure
            -- If we fell off, did we do it at a leaf? Otherwise, what's the
            -- subtree that we're at
            getNext :: Tree T.Text -> T.Text -> Either Bool (Tree T.Text)
            getNext :: Tree Text -> Text -> Either Bool (Tree Text)
    getNext Tree Text
    t Text
    s' = case Text -> Map Text (Tree Text) -> Maybe (Tree Text)
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Text
    s' (Map Text (Tree Text) -> Maybe (Tree Text))
    -> Map Text (Tree Text) -> Maybe (Tree Text)
    forall a b. (a -> b) -> a -> b
    $ Tree Text -> Map Text (Tree Text)
    forall e. Tree e -> Map e (Tree e)
    children Tree Text
    t of
              Maybe (Tree Text)
    Nothing -> Bool -> Either Bool (Tree Text)
    forall a b. a -> Either a b
    Left (Map Text (Tree Text) -> Bool
    forall k a. Map k a -> Bool
    M.null (Map Text (Tree Text) -> Bool) -> Map Text (Tree Text) -> Bool
    forall a b. (a -> b) -> a -> b
    $ Tree Text -> Map Text (Tree Text)
    forall e. Tree e -> Map e (Tree e)
    children Tree Text
    t)
              Just Tree Text
    t' -> Tree Text -> Either Bool (Tree Text)
    forall a b. b -> Either a b
    Right Tree Text
    t'
            getNextWithStar :: Tree Text -> Text -> Either Bool (Tree Text)
    getNextWithStar Tree Text
    t Text
    s' = case Tree Text -> Text -> Either Bool (Tree Text)
    getNext Tree Text
    t Text
    s' of
              Left Bool
    _ -> Tree Text -> Text -> Either Bool (Tree Text)
    getNext Tree Text
    t Text
    "*"
              Either Bool (Tree Text)
    r -> Either Bool (Tree Text)
    r
            recurse :: [T.Text] -> [T.Text] -> Tree T.Text -> LookupResult
            recurse :: [Text] -> [Text] -> Tree Text -> LookupResult
    recurse [] [Text]
    _ Tree Text
    t
              | Map Text (Tree Text) -> Bool
    forall k a. Map k a -> Bool
    M.null (Map Text (Tree Text) -> Bool) -> Map Text (Tree Text) -> Bool
    forall a b. (a -> b) -> a -> b
    $ Tree Text -> Map Text (Tree Text)
    forall e. Tree e -> Map e (Tree e)
    children Tree Text
    t = LookupResult
    AtLeaf
              | Bool
    otherwise = LookupResult
    Inside
            recurse (Text
    c : [Text]
    cs) [Text]
    prev Tree Text
    t = case Tree Text -> Text -> Either Bool (Tree Text)
    getNextWithStar Tree Text
    t Text
    c of
              Left Bool
    b -> Bool -> Text -> LookupResult
    OffEnd Bool
    b (Text -> LookupResult) -> Text -> LookupResult
    forall a b. (a -> b) -> a -> b
    $ Text -> [Text] -> Text
    T.intercalate Text
    "." (Text
    c Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : [Text]
    prev)
              Right Tree Text
    t' -> [Text] -> [Text] -> Tree Text -> LookupResult
    recurse [Text]
    cs (Text
    c Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : [Text]
    prev) Tree Text
    t'
            -- Only match against the exception rules if we have a full match
            output :: LookupResult -> LookupResult -> Maybe Text
    output LookupResult
    _ LookupResult
    AtLeaf = Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    s
            output LookupResult
    _ (OffEnd Bool
    True Text
    x) = Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ Text -> [Text] -> Text
    T.intercalate Text
    "." ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ [Text] -> [Text]
    forall a. HasCallStack => [a] -> [a]
    tail ([Text] -> [Text]) -> [Text] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => Text -> Text -> [Text]
    Text -> Text -> [Text]
    T.splitOn Text
    "." Text
    x
            -- If we have a subdomain on an existing rule, we're not a suffix
            output (OffEnd Bool
    _ Text
    x) LookupResult
    _
              -- A single level domain can never be a eTLD+1
              | Maybe Char -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe Char -> Bool) -> Maybe Char -> Bool
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> Text -> Maybe Char
    T.find (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '.') Text
    x = Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ Text -> [Text] -> Text
    T.intercalate Text
    "." ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ Int -> [Text] -> [Text]
    forall a. Int -> [a] -> [a]
    drop ([Text] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Text]
    ss Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2) [Text]
    ss
              | Bool
    otherwise = Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    x
            -- Otherwise, we're a suffix of a suffix, which is a suffix
            output LookupResult
    _ LookupResult
    _ = Maybe Text
    forall a. Maybe a
    Nothing

    -- | >>> effectiveTLDPlusOne = effectiveTLDPlusOne' Network.PublicSuffixList.DataStructure.dataStructure
    effectiveTLDPlusOne :: T.Text -> Maybe T.Text
    effectiveTLDPlusOne :: Text -> Maybe Text
    effectiveTLDPlusOne = DataStructure -> Text -> Maybe Text
    effectiveTLDPlusOne' DataStructure
    DS.dataStructure

    -- | >>> isSuffix' dataStructure = isNothing . effectiveTLDPlusOne' dataStructure
    isSuffix' :: DataStructure -> T.Text -> Bool
    isSuffix' :: DataStructure -> Text -> Bool
    isSuffix' DataStructure
    dataStructure = Maybe Text -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe Text -> Bool) -> (Text -> Maybe Text) -> Text -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DataStructure -> Text -> Maybe Text
    effectiveTLDPlusOne' DataStructure
    dataStructure

    -- | >>> isSuffix = isSuffix' Network.PublicSuffixList.DataStructure.dataStructure
    isSuffix :: T.Text -> Bool
    isSuffix :: Text -> Bool
    isSuffix = Maybe Text -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe Text -> Bool) -> (Text -> Maybe Text) -> Text -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Maybe Text
    effectiveTLDPlusOne