module Data.URI.Auth where
import Data.URI.Auth.Host (URIAuthHost, parseURIAuthHost)
import Prelude hiding (Maybe (..))
import Data.Strict.Maybe (Maybe (..), fromMaybe)
import Data.Text (Text)
import Data.Word (Word16)
import qualified Data.Text as T
import Data.Attoparsec.Text (Parser, many1, char, notChar, satisfy, decimal, peekChar)
import Data.Monoid ((<>))
import Control.Applicative ((<|>))
import qualified GHC.Base
import Data.Data (Data, Typeable)
import GHC.Generics (Generic)
deriving instance Data a => Data (Maybe a)
data URIAuth = URIAuth
{ uriAuthUser :: !(Maybe Text)
, uriAuthHost :: !URIAuthHost
, uriAuthPort :: !(Maybe Word16)
} deriving (Eq, Data, Typeable, Generic)
instance Show URIAuth where
show URIAuth{..} =
fromMaybe "" ((\u -> T.unpack $ u <> "@") <$> uriAuthUser)
++ show uriAuthHost
++ fromMaybe "" ((\p -> ":" ++ show p) <$> uriAuthPort)
parseURIAuth :: Parser URIAuth
parseURIAuth =
URIAuth <$> ((Just <$> parseUser) <|> pure Nothing)
<*> parseURIAuthHost
<*> ((Just <$> parsePort) <|> pure Nothing)
where
parseUser = do
u <- many1 $ satisfy $ \c -> all (c /=) ['@','.',':','/','?','&','=']
mC <- peekChar
case mC of
GHC.Base.Nothing -> fail "no user @ thing"
_ -> do
_ <- char '@'
pure $ T.pack u
parsePort = do
_ <- char ':'
decimal