{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}

module Dormouse.Url
  ( module Dormouse.Url.Types
  , ensureHttp
  , ensureHttps
  , parseUrl
  , parseHttpUrl
  , parseHttpsUrl
  , IsUrl(..)
  ) where

import Control.Exception.Safe (MonadThrow, throw)
import qualified Data.ByteString as SB
import qualified Data.Text as T
import Dormouse.Url.Exception (UrlException(..))
import Dormouse.Uri
import Dormouse.Url.Class
import Dormouse.Url.Types

-- | Ensure that the supplied Url uses the _http_ scheme, throwing a 'UrlException' in @m@ if this is not the case
ensureHttp :: MonadThrow m => AnyUrl -> m (Url "http")
ensureHttp :: AnyUrl -> m (Url "http")
ensureHttp (AnyUrl (HttpUrl UrlComponents
u)) = Url "http" -> m (Url "http")
forall (m :: * -> *) a. Monad m => a -> m a
return (Url "http" -> m (Url "http")) -> Url "http" -> m (Url "http")
forall a b. (a -> b) -> a -> b
$ UrlComponents -> Url "http"
HttpUrl UrlComponents
u
ensureHttp (AnyUrl (HttpsUrl UrlComponents
_)) = UrlException -> m (Url "http")
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw (UrlException -> m (Url "http")) -> UrlException -> m (Url "http")
forall a b. (a -> b) -> a -> b
$ Text -> UrlException
UrlException Text
"Supplied url was an https url, not an http url"

-- | Ensure that the supplied Url uses the _https_ scheme, throwing a 'UrlException' in @m@ if this is not the case
ensureHttps :: MonadThrow m => AnyUrl -> m (Url "https")
ensureHttps :: AnyUrl -> m (Url "https")
ensureHttps (AnyUrl (HttpsUrl UrlComponents
u)) = Url "https" -> m (Url "https")
forall (m :: * -> *) a. Monad m => a -> m a
return (Url "https" -> m (Url "https")) -> Url "https" -> m (Url "https")
forall a b. (a -> b) -> a -> b
$ UrlComponents -> Url "https"
HttpsUrl UrlComponents
u
ensureHttps (AnyUrl (HttpUrl UrlComponents
_)) = UrlException -> m (Url "https")
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw (UrlException -> m (Url "https"))
-> UrlException -> m (Url "https")
forall a b. (a -> b) -> a -> b
$ Text -> UrlException
UrlException Text
"Supplied url was an http url, not an https url"

-- | Ensure that the supplied Uri is a Url
ensureUrl :: MonadThrow m => Uri -> m AnyUrl
ensureUrl :: Uri -> m AnyUrl
ensureUrl (AbsoluteUri AbsUri {$sel:uriScheme:AbsUri :: AbsUri -> Scheme
uriScheme = Scheme
scheme, $sel:uriAuthority:AbsUri :: AbsUri -> Maybe Authority
uriAuthority = Maybe Authority
maybeAuthority, $sel:uriPath:AbsUri :: AbsUri -> Path 'Absolute
uriPath = Path 'Absolute
path, $sel:uriQuery:AbsUri :: AbsUri -> Maybe Query
uriQuery = Maybe Query
query, $sel:uriFragment:AbsUri :: AbsUri -> Maybe Fragment
uriFragment = Maybe Fragment
fragment}) = do
  Authority
authority <- m Authority
-> (Authority -> m Authority) -> Maybe Authority -> m Authority
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (UrlException -> m Authority
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw (UrlException -> m Authority) -> UrlException -> m Authority
forall a b. (a -> b) -> a -> b
$ Text -> UrlException
UrlException Text
"Supplied Url had no authority component") Authority -> m Authority
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Authority
maybeAuthority
  case Scheme -> Text
unScheme Scheme
scheme of
    Text
"http"  -> AnyUrl -> m AnyUrl
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyUrl -> m AnyUrl) -> AnyUrl -> m AnyUrl
forall a b. (a -> b) -> a -> b
$ Url "http" -> AnyUrl
forall (scheme :: Symbol). Url scheme -> AnyUrl
AnyUrl (Url "http" -> AnyUrl) -> Url "http" -> AnyUrl
forall a b. (a -> b) -> a -> b
$ UrlComponents -> Url "http"
HttpUrl UrlComponents :: Authority
-> Path 'Absolute -> Maybe Query -> Maybe Fragment -> UrlComponents
UrlComponents { $sel:urlAuthority:UrlComponents :: Authority
urlAuthority = Authority
authority, $sel:urlPath:UrlComponents :: Path 'Absolute
urlPath = Path 'Absolute
path, $sel:urlQuery:UrlComponents :: Maybe Query
urlQuery = Maybe Query
query, $sel:urlFragment:UrlComponents :: Maybe Fragment
urlFragment = Maybe Fragment
fragment }
    Text
"https" -> AnyUrl -> m AnyUrl
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyUrl -> m AnyUrl) -> AnyUrl -> m AnyUrl
forall a b. (a -> b) -> a -> b
$ Url "https" -> AnyUrl
forall (scheme :: Symbol). Url scheme -> AnyUrl
AnyUrl (Url "https" -> AnyUrl) -> Url "https" -> AnyUrl
forall a b. (a -> b) -> a -> b
$ UrlComponents -> Url "https"
HttpsUrl UrlComponents :: Authority
-> Path 'Absolute -> Maybe Query -> Maybe Fragment -> UrlComponents
UrlComponents { $sel:urlAuthority:UrlComponents :: Authority
urlAuthority = Authority
authority, $sel:urlPath:UrlComponents :: Path 'Absolute
urlPath = Path 'Absolute
path, $sel:urlQuery:UrlComponents :: Maybe Query
urlQuery = Maybe Query
query, $sel:urlFragment:UrlComponents :: Maybe Fragment
urlFragment = Maybe Fragment
fragment }
    Text
s       -> UrlException -> m AnyUrl
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw (UrlException -> m AnyUrl) -> UrlException -> m AnyUrl
forall a b. (a -> b) -> a -> b
$ Text -> UrlException
UrlException (Text
"Supplied Url had a scheme of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Text -> String
forall a. Show a => a -> String
show Text
s) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" which was not http or https.")
ensureUrl (RelativeUri RelUri
_) = UrlException -> m AnyUrl
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw (UrlException -> m AnyUrl) -> UrlException -> m AnyUrl
forall a b. (a -> b) -> a -> b
$ Text -> UrlException
UrlException Text
"Supplied Uri was a relative Uri - it must provide a scheme and authority to be considered a valid url"

-- | Parse an ascii 'ByteString' as a url, throwing a 'UriException' in @m@ if this fails
parseUrl :: MonadThrow m => SB.ByteString -> m AnyUrl
parseUrl :: ByteString -> m AnyUrl
parseUrl ByteString
bs = do
  Uri
url <- ByteString -> m Uri
forall (m :: * -> *). MonadThrow m => ByteString -> m Uri
parseUri ByteString
bs
  Uri -> m AnyUrl
forall (m :: * -> *). MonadThrow m => Uri -> m AnyUrl
ensureUrl Uri
url
  
-- | Parse an ascii 'ByteString' as an http url, throwing a 'UriException' in @m@ if this fails
parseHttpUrl :: MonadThrow m => SB.ByteString -> m (Url "http")
parseHttpUrl :: ByteString -> m (Url "http")
parseHttpUrl ByteString
text = do 
  AnyUrl
anyUrl <- ByteString -> m AnyUrl
forall (m :: * -> *). MonadThrow m => ByteString -> m AnyUrl
parseUrl ByteString
text
  AnyUrl -> m (Url "http")
forall (m :: * -> *). MonadThrow m => AnyUrl -> m (Url "http")
ensureHttp AnyUrl
anyUrl

-- | Parse an ascii 'ByteString' as an https url, throwing a 'UriException' in @m@ if this fails
parseHttpsUrl :: MonadThrow m => SB.ByteString -> m (Url "https")
parseHttpsUrl :: ByteString -> m (Url "https")
parseHttpsUrl ByteString
text = do 
  AnyUrl
anyUrl <- ByteString -> m AnyUrl
forall (m :: * -> *). MonadThrow m => ByteString -> m AnyUrl
parseUrl ByteString
text
  AnyUrl -> m (Url "https")
forall (m :: * -> *). MonadThrow m => AnyUrl -> m (Url "https")
ensureHttps AnyUrl
anyUrl