{- |
Module      : Web.Api.WebDriver.Uri
Description : Types and functions for validating parts of a URI.
Copyright   : 2018, Automattic, Inc.
License     : GPL-3
Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)
Stability   : experimental
Portability : POSIX
-}

module Web.Api.WebDriver.Uri (
    Host()
  , mkHost
  , Port()
  , mkPort
  ) where

import Data.Text (Text)
import qualified Data.Text as T
import Test.QuickCheck
  ( Arbitrary(..), oneof, vectorOf, Positive(..) )


-- | The host part of a URI. See <https://tools.ietf.org/html/rfc3986#page-18>.
newtype Host = Host
  { Host -> Text
unHost :: Text
  } deriving Host -> Host -> Bool
(Host -> Host -> Bool) -> (Host -> Host -> Bool) -> Eq Host
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Host -> Host -> Bool
$c/= :: Host -> Host -> Bool
== :: Host -> Host -> Bool
$c== :: Host -> Host -> Bool
Eq

-- | Constructor for hosts that checks for invalid characters.
mkHost :: Text -> Maybe Host
mkHost :: Text -> Maybe Host
mkHost Text
str =
  if (Char -> Bool) -> Text -> Bool
T.all (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
hostAllowedChars) Text
str
    then Host -> Maybe Host
forall a. a -> Maybe a
Just (Text -> Host
Host Text
str)
    else Maybe Host
forall a. Maybe a
Nothing

instance Show Host where
  show :: Host -> [Char]
show = Text -> [Char]
T.unpack (Text -> [Char]) -> (Host -> Text) -> Host -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Host -> Text
unHost

instance Arbitrary Host where
  arbitrary :: Gen Host
arbitrary = do
    Positive Int
k <- Gen (Positive Int)
forall a. Arbitrary a => Gen a
arbitrary
    [Char]
str <- Int -> Gen Char -> Gen [Char]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
k (Gen Char -> Gen [Char]) -> Gen Char -> Gen [Char]
forall a b. (a -> b) -> a -> b
$ [Gen Char] -> Gen Char
forall a. [Gen a] -> Gen a
oneof ([Gen Char] -> Gen Char) -> [Gen Char] -> Gen Char
forall a b. (a -> b) -> a -> b
$ (Char -> Gen Char) -> [Char] -> [Gen Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Gen Char
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
hostAllowedChars
    case Text -> Maybe Host
mkHost (Text -> Maybe Host) -> Text -> Maybe Host
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
str of
      Just Host
h -> Host -> Gen Host
forall (m :: * -> *) a. Monad m => a -> m a
return Host
h
      Maybe Host
Nothing -> [Char] -> Gen Host
forall a. HasCallStack => [Char] -> a
error [Char]
"In Arbitrary instance for Host: bad characters."

hostAllowedChars :: [Char]
hostAllowedChars :: [Char]
hostAllowedChars = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ [Char
'a'..Char
'z'], [Char
'A'..Char
'Z'], [Char
'0'..Char
'9'], [Char
'-',Char
'_',Char
'.',Char
'~',Char
'%'] ]



-- | The port part of a URI.
newtype Port = Port { Port -> Text
unPort :: Text }
  deriving Port -> Port -> Bool
(Port -> Port -> Bool) -> (Port -> Port -> Bool) -> Eq Port
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Port -> Port -> Bool
$c/= :: Port -> Port -> Bool
== :: Port -> Port -> Bool
$c== :: Port -> Port -> Bool
Eq

-- | Constructor for ports.
mkPort :: Text -> Maybe Port
mkPort :: Text -> Maybe Port
mkPort Text
str =
  if (Char -> Bool) -> Text -> Bool
T.all (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'0'..Char
'9']) Text
str
    then Port -> Maybe Port
forall a. a -> Maybe a
Just (Text -> Port
Port Text
str)
    else Maybe Port
forall a. Maybe a
Nothing

instance Show Port where
  show :: Port -> [Char]
show = Text -> [Char]
T.unpack (Text -> [Char]) -> (Port -> Text) -> Port -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Port -> Text
unPort

instance Arbitrary Port where
  arbitrary :: Gen Port
arbitrary = do
    Positive Int
k <- Gen (Positive Int)
forall a. Arbitrary a => Gen a
arbitrary
    [Char]
str <- Int -> Gen Char -> Gen [Char]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
k (Gen Char -> Gen [Char]) -> Gen Char -> Gen [Char]
forall a b. (a -> b) -> a -> b
$ [Gen Char] -> Gen Char
forall a. [Gen a] -> Gen a
oneof ([Gen Char] -> Gen Char) -> [Gen Char] -> Gen Char
forall a b. (a -> b) -> a -> b
$ (Char -> Gen Char) -> [Char] -> [Gen Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Gen Char
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
'0'..Char
'9']
    case Text -> Maybe Port
mkPort (Text -> Maybe Port) -> Text -> Maybe Port
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
str of
      Just Port
p -> Port -> Gen Port
forall (m :: * -> *) a. Monad m => a -> m a
return Port
p
      Maybe Port
Nothing -> [Char] -> Gen Port
forall a. HasCallStack => [Char] -> a
error [Char]
"In Arbitrary instance for Port: bad characters."