{- | The private construction boundary for 'RegistryUrl'.

This module is __not exposed__ from @ecluse-core@ (it is an @other-module@), so the
raw 'RegistryUrl' constructor is reachable only from inside the library. The public
"Ecluse.Core.Security.Egress" re-exports the type /abstractly/, with the https-only
'mkRegistryUrl' as the sole production builder; the test- and dev-only loopback
builder in "Ecluse.Core.Security.Egress.DevHttp" is compiled only under the
@dev-http-egress@ Cabal flag. A release build therefore carries no way to construct a
non-https registry target, in code or in configuration.
-}
module Ecluse.Core.Security.Egress.Internal (
    RegistryUrl (..),
    mkRegistryUrl,
    registryUrlText,
) where

import Data.Text qualified as T

{- | An outbound registry-egress URL that is __https by construction__. The only
production constructor, 'mkRegistryUrl', rejects any non-https scheme, so a
plain-HTTP registry target cannot be represented in a running system: every
configured upstream, mirror, and publication endpoint, and every @dist.tarball@
target, is one of these. Stored normalised (surrounding whitespace trimmed).
-}
newtype RegistryUrl = RegistryUrl Text
    deriving stock (RegistryUrl -> RegistryUrl -> Bool
(RegistryUrl -> RegistryUrl -> Bool)
-> (RegistryUrl -> RegistryUrl -> Bool) -> Eq RegistryUrl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegistryUrl -> RegistryUrl -> Bool
== :: RegistryUrl -> RegistryUrl -> Bool
$c/= :: RegistryUrl -> RegistryUrl -> Bool
/= :: RegistryUrl -> RegistryUrl -> Bool
Eq, Eq RegistryUrl
Eq RegistryUrl =>
(RegistryUrl -> RegistryUrl -> Ordering)
-> (RegistryUrl -> RegistryUrl -> Bool)
-> (RegistryUrl -> RegistryUrl -> Bool)
-> (RegistryUrl -> RegistryUrl -> Bool)
-> (RegistryUrl -> RegistryUrl -> Bool)
-> (RegistryUrl -> RegistryUrl -> RegistryUrl)
-> (RegistryUrl -> RegistryUrl -> RegistryUrl)
-> Ord RegistryUrl
RegistryUrl -> RegistryUrl -> Bool
RegistryUrl -> RegistryUrl -> Ordering
RegistryUrl -> RegistryUrl -> RegistryUrl
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RegistryUrl -> RegistryUrl -> Ordering
compare :: RegistryUrl -> RegistryUrl -> Ordering
$c< :: RegistryUrl -> RegistryUrl -> Bool
< :: RegistryUrl -> RegistryUrl -> Bool
$c<= :: RegistryUrl -> RegistryUrl -> Bool
<= :: RegistryUrl -> RegistryUrl -> Bool
$c> :: RegistryUrl -> RegistryUrl -> Bool
> :: RegistryUrl -> RegistryUrl -> Bool
$c>= :: RegistryUrl -> RegistryUrl -> Bool
>= :: RegistryUrl -> RegistryUrl -> Bool
$cmax :: RegistryUrl -> RegistryUrl -> RegistryUrl
max :: RegistryUrl -> RegistryUrl -> RegistryUrl
$cmin :: RegistryUrl -> RegistryUrl -> RegistryUrl
min :: RegistryUrl -> RegistryUrl -> RegistryUrl
Ord, Int -> RegistryUrl -> ShowS
[RegistryUrl] -> ShowS
RegistryUrl -> String
(Int -> RegistryUrl -> ShowS)
-> (RegistryUrl -> String)
-> ([RegistryUrl] -> ShowS)
-> Show RegistryUrl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegistryUrl -> ShowS
showsPrec :: Int -> RegistryUrl -> ShowS
$cshow :: RegistryUrl -> String
show :: RegistryUrl -> String
$cshowList :: [RegistryUrl] -> ShowS
showList :: [RegistryUrl] -> ShowS
Show)

{- | Build a 'RegistryUrl', accepting only an @https:\/\/@ URL (the scheme matched
case-insensitively, since URI schemes are). A non-https or empty value is rejected
with a reason that names the requirement, so the aggregating configuration layer can
fail closed at boot and report the offending value.

>>> mkRegistryUrl "https://registry.npmjs.org"
Right (RegistryUrl "https://registry.npmjs.org")

>>> mkRegistryUrl "http://registry.npmjs.org"
Left "registry URL must use https (got http://registry.npmjs.org)"
-}
mkRegistryUrl :: Text -> Either Text RegistryUrl
mkRegistryUrl :: Text -> Either Text RegistryUrl
mkRegistryUrl Text
raw
    | Text -> Bool
T.null Text
trimmed = Text -> Either Text RegistryUrl
forall a b. a -> Either a b
Left Text
"expected a non-empty https URL"
    | Text
"https://" Text -> Text -> Bool
`T.isPrefixOf` Text -> Text
T.toLower Text
trimmed = RegistryUrl -> Either Text RegistryUrl
forall a b. b -> Either a b
Right (Text -> RegistryUrl
RegistryUrl Text
trimmed)
    | Bool
otherwise = Text -> Either Text RegistryUrl
forall a b. a -> Either a b
Left (Text
"registry URL must use https (got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
trimmed Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
  where
    trimmed :: Text
trimmed = Text -> Text
T.strip Text
raw

-- | The underlying URL text.
registryUrlText :: RegistryUrl -> Text
registryUrlText :: RegistryUrl -> Text
registryUrlText (RegistryUrl Text
u) = Text
u