{-# LANGUAGE
RecordWildCards
, OverloadedStrings
, DeriveGeneric
, DeriveDataTypeable
#-}
module Data.URI.Auth where
import Data.URI.Auth.Host (URIAuthHost, parseURIAuthHost, printURIAuthHost)
import Prelude hiding (Maybe (..), maybe)
import qualified Prelude as P
import Data.Strict.Maybe (Maybe (..), maybe)
import Data.Text (Text)
import Data.Word (Word16)
import qualified Data.Text as T
import Data.Attoparsec.Text ( Parser, char, decimal, takeWhile1, (<?>))
import Control.Monad (void)
import Control.Applicative (optional)
import Data.Data (Typeable)
import GHC.Generics (Generic)
import Test.QuickCheck (Arbitrary (..))
import Test.QuickCheck.Gen (oneof, listOf1, elements)
data URIAuth = URIAuth
{ URIAuth -> Maybe Text
uriAuthUser :: !(Maybe Text)
, URIAuth -> Maybe Text
uriAuthPassword :: !(Maybe Text)
, URIAuth -> URIAuthHost
uriAuthHost :: !URIAuthHost
, URIAuth -> Maybe Word16
uriAuthPort :: !(Maybe Word16)
} deriving (Int -> URIAuth -> ShowS
[URIAuth] -> ShowS
URIAuth -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [URIAuth] -> ShowS
$cshowList :: [URIAuth] -> ShowS
show :: URIAuth -> String
$cshow :: URIAuth -> String
showsPrec :: Int -> URIAuth -> ShowS
$cshowsPrec :: Int -> URIAuth -> ShowS
Show, URIAuth -> URIAuth -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URIAuth -> URIAuth -> Bool
$c/= :: URIAuth -> URIAuth -> Bool
== :: URIAuth -> URIAuth -> Bool
$c== :: URIAuth -> URIAuth -> Bool
Eq, Typeable, forall x. Rep URIAuth x -> URIAuth
forall x. URIAuth -> Rep URIAuth x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep URIAuth x -> URIAuth
$cfrom :: forall x. URIAuth -> Rep URIAuth x
Generic)
instance Arbitrary URIAuth where
arbitrary :: Gen URIAuth
arbitrary = do
Maybe Text
mUser <- Gen (Maybe Text)
arbitraryUser
Maybe Text
mPassword <- if Maybe Text
mUser forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
arbitraryNonEmptyText
URIAuthHost
host <- forall a. Arbitrary a => Gen a
arbitrary
Maybe Word16
mPort <- Gen (Maybe Word16)
arbitraryPort
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Maybe Text -> URIAuthHost -> Maybe Word16 -> URIAuth
URIAuth Maybe Text
mUser Maybe Text
mPassword URIAuthHost
host Maybe Word16
mPort)
where
arbitraryUser :: Gen (Maybe Text)
arbitraryUser = forall a. [Gen a] -> Gen a
oneof [forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
arbitraryNonEmptyText]
arbitraryPort :: Gen (Maybe Word16)
arbitraryPort = forall a. [Gen a] -> Gen a
oneof [forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary]
arbitraryNonEmptyText :: Gen Text
arbitraryNonEmptyText = String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Gen a -> Gen [a]
listOf1 (forall a. [a] -> Gen a
elements [Char
'a' .. Char
'z'])
printURIAuth :: URIAuth -> Text
printURIAuth :: URIAuth -> Text
printURIAuth URIAuth{Maybe Word16
Maybe Text
URIAuthHost
uriAuthPort :: Maybe Word16
uriAuthHost :: URIAuthHost
uriAuthPassword :: Maybe Text
uriAuthUser :: Maybe Text
uriAuthPort :: URIAuth -> Maybe Word16
uriAuthHost :: URIAuth -> URIAuthHost
uriAuthPassword :: URIAuth -> Maybe Text
uriAuthUser :: URIAuth -> Maybe Text
..} =
( case Maybe Text
uriAuthPassword of
Maybe Text
Nothing -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (forall a. Semigroup a => a -> a -> a
<> Text
"@") Maybe Text
uriAuthUser
Just Text
p -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
":" (forall a. Semigroup a => a -> a -> a
<> Text
":") Maybe Text
uriAuthUser forall a. Semigroup a => a -> a -> a
<> Text
p forall a. Semigroup a => a -> a -> a
<> Text
"@"
)
forall a. Semigroup a => a -> a -> a
<> URIAuthHost -> Text
printURIAuthHost URIAuthHost
uriAuthHost
forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Word16
p -> Text
":" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Word16
p)) Maybe Word16
uriAuthPort
parseURIAuth :: Parser URIAuth
parseURIAuth :: Parser URIAuth
parseURIAuth = do
let withPassword :: Parser Text Text
withPassword = do
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Char
char Char
':')
Parser Text Text
parsePassword
hasUsernameOrPassword :: Parser Text (Maybe Text, Maybe Text)
hasUsernameOrPassword = do
Maybe Text
u <- forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
parseUser
Maybe Text
p <- forall {a}. Maybe a -> Maybe a
toStrictMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text Text
withPassword
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Char
char Char
'@')
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text
u,Maybe Text
p)
(Maybe Text
u,Maybe Text
p) <- do
Maybe (Maybe Text, Maybe Text)
mUP <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text (Maybe Text, Maybe Text)
hasUsernameOrPassword
case Maybe (Maybe Text, Maybe Text)
mUP of
Maybe (Maybe Text, Maybe Text)
P.Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
P.Just (Maybe Text, Maybe Text)
xs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text, Maybe Text)
xs
Maybe Text -> Maybe Text -> URIAuthHost -> Maybe Word16 -> URIAuth
URIAuth Maybe Text
u
Maybe Text
p
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser URIAuthHost
parseURIAuthHost
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall {a}. Maybe a -> Maybe a
toStrictMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text Word16
parsePort)
where
parseUser :: Parser Text Text
parseUser = (Char -> Bool) -> Parser Text Text
takeWhile1 (\Char
c -> Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'@',Char
'.',Char
':',Char
'/',Char
'?',Char
'&',Char
'=',Char
'[']) forall i a. Parser i a -> String -> Parser i a
<?> String
"user value"
parsePassword :: Parser Text Text
parsePassword = (Char -> Bool) -> Parser Text Text
takeWhile1 (\Char
c -> Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'@',Char
'.',Char
':',Char
'/',Char
'?',Char
'&',Char
'=',Char
'[']) forall i a. Parser i a -> String -> Parser i a
<?> String
"password value"
parsePort :: Parser Text Word16
parsePort = do
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Parser Char
char Char
':') forall i a. Parser i a -> String -> Parser i a
<?> String
"port delimiter"
forall a. Integral a => Parser a
decimal
toStrictMaybe :: Maybe a -> Maybe a
toStrictMaybe Maybe a
P.Nothing = forall a. Maybe a
Nothing
toStrictMaybe (P.Just a
x) = forall a. a -> Maybe a
Just a
x