{-# OPTIONS_GHC -Wno-unused-top-binds #-}

module Iri.Rendering.Ptr.Poking
  ( uri,
    httpUri,
    scheme,
    host,
    path,
    query,
  )
where

import qualified Data.ByteString as ByteString
import qualified Data.Text as C
import qualified Data.Text.Encoding as A
import qualified Data.Text.Punycode as B
import qualified Iri.CodePointPredicates.Core as I
import qualified Iri.CodePointPredicates.Rfc3986 as I
import Iri.Data
import Iri.Prelude hiding (null, poke)
import qualified Iri.Rendering.Ptr.Poke as L
import qualified Iri.Utf8CodePoint as K
import qualified Iri.Vector as F
import qualified Net.IPv4 as D
import qualified Net.IPv6 as E
import Ptr.Poking

uri :: Iri -> Poking
uri :: Iri -> Poking
uri (Iri Scheme
schemeValue Hierarchy
hierarchyValue Query
queryValue Fragment
fragmentValue) =
  Scheme -> Poking
scheme Scheme
schemeValue
    Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Char -> Poking
asciiChar Char
':'
    Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Hierarchy -> Poking
hierarchy Hierarchy
hierarchyValue
    Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> ( Poking -> Poking -> Poking
prependIfNotNull
           (Char -> Poking
asciiChar Char
'?')
           (Query -> Poking
query Query
queryValue)
       )
    Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> ( Poking -> Poking -> Poking
prependIfNotNull
           (Char -> Poking
asciiChar Char
'#')
           (Fragment -> Poking
fragment Fragment
fragmentValue)
       )

httpUri :: HttpIri -> Poking
httpUri :: HttpIri -> Poking
httpUri (HttpIri (Security Bool
secure) Host
hostValue Port
portValue Path
pathValue Query
queryValue Fragment
fragmentValue) =
  (if Bool
secure then Poking
"https://" else Poking
"http://")
    Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Host -> Poking
host Host
hostValue
    Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Poking -> Poking -> Poking
prependIfNotNull (Char -> Poking
asciiChar Char
':') (Port -> Poking
port Port
portValue)
    Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Poking -> Poking -> Poking
prependIfNotNull (Char -> Poking
asciiChar Char
'/') (Path -> Poking
path Path
pathValue)
    Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Poking -> Poking -> Poking
prependIfNotNull (Char -> Poking
asciiChar Char
'?') (Query -> Poking
query Query
queryValue)
    Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Poking -> Poking -> Poking
prependIfNotNull (Char -> Poking
asciiChar Char
'#') (Fragment -> Poking
fragment Fragment
fragmentValue)

scheme :: Scheme -> Poking
scheme :: Scheme -> Poking
scheme (Scheme ByteString
value) =
  ByteString -> Poking
bytes ByteString
value

hierarchy :: Hierarchy -> Poking
hierarchy :: Hierarchy -> Poking
hierarchy =
  \case
    AuthorisedHierarchy Authority
authorityValue Path
pathValue ->
      ByteString -> Poking
bytes ByteString
"//" Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Authority -> Poking
authority Authority
authorityValue Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Poking -> Poking -> Poking
prependIfNotNull (Char -> Poking
asciiChar Char
'/') (Path -> Poking
path Path
pathValue)
    AbsoluteHierarchy Path
pathValue ->
      Char -> Poking
asciiChar Char
'/' Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Path -> Poking
path Path
pathValue
    RelativeHierarchy Path
pathValue ->
      Path -> Poking
path Path
pathValue

authority :: Authority -> Poking
authority :: Authority -> Poking
authority (Authority UserInfo
userInfoValue Host
hostValue Port
portValue) =
  Poking -> Poking -> Poking
appendIfNotNull (Char -> Poking
asciiChar Char
'@') (UserInfo -> Poking
userInfo UserInfo
userInfoValue)
    Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Host -> Poking
host Host
hostValue
    Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Poking -> Poking -> Poking
prependIfNotNull (Char -> Poking
asciiChar Char
':') (Port -> Poking
port Port
portValue)

userInfo :: UserInfo -> Poking
userInfo :: UserInfo -> Poking
userInfo =
  \case
    PresentUserInfo (User ByteString
user) Password
password -> case Password
password of
      PresentPassword ByteString
password -> ByteString -> Poking
userInfoComponent ByteString
user Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Char -> Poking
asciiChar Char
':' Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> ByteString -> Poking
userInfoComponent ByteString
password
      Password
MissingPassword -> ByteString -> Poking
userInfoComponent ByteString
user
    UserInfo
MissingUserInfo -> Poking
forall a. Monoid a => a
mempty

userInfoComponent :: ByteString -> Poking
userInfoComponent :: ByteString -> Poking
userInfoComponent =
  Predicate -> ByteString -> Poking
urlEncodedBytes Predicate
I.unencodedUserInfoComponent

host :: Host -> Poking
host :: Host -> Poking
host =
  \case
    NamedHost RegName
value -> RegName -> Poking
domainName RegName
value
    IpV4Host IPv4
value -> IPv4 -> Poking
ipV4 IPv4
value
    IpV6Host IPv6
value -> IPv6 -> Poking
ipV6 IPv6
value

domainName :: RegName -> Poking
domainName :: RegName -> Poking
domainName (RegName Vector DomainLabel
vector) =
  (DomainLabel -> Poking) -> Poking -> Vector DomainLabel -> Poking
forall monoid element.
Monoid monoid =>
(element -> monoid) -> monoid -> Vector element -> monoid
F.intercalate DomainLabel -> Poking
domainLabel (Char -> Poking
asciiChar Char
'.') Vector DomainLabel
vector

domainLabel :: DomainLabel -> Poking
domainLabel :: DomainLabel -> Poking
domainLabel (DomainLabel Text
value) =
  if (Char -> Bool) -> Text -> Bool
C.all (Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x80') Text
value
    then ByteString -> Poking
bytes (Text -> ByteString
A.encodeUtf8 Text
value)
    else ByteString -> Poking
bytes ByteString
"xn--" Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> ByteString -> Poking
bytes (Text -> ByteString
B.encode Text
value)

ipV4 :: IPv4 -> Poking
ipV4 :: IPv4 -> Poking
ipV4 =
  ByteString -> Poking
bytes (ByteString -> Poking) -> (IPv4 -> ByteString) -> IPv4 -> Poking
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByteString
A.encodeUtf8 (Text -> ByteString) -> (IPv4 -> Text) -> IPv4 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IPv4 -> Text
D.encode

ipV6 :: IPv6 -> Poking
ipV6 :: IPv6 -> Poking
ipV6 =
  ByteString -> Poking
bytes (ByteString -> Poking) -> (IPv6 -> ByteString) -> IPv6 -> Poking
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByteString
A.encodeUtf8 (Text -> ByteString) -> (IPv6 -> Text) -> IPv6 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IPv6 -> Text
E.encode

port :: Port -> Poking
port :: Port -> Poking
port =
  \case
    PresentPort Word16
value -> Word16 -> Poking
forall a. Integral a => a -> Poking
asciiIntegral Word16
value
    Port
MissingPort -> Poking
forall a. Monoid a => a
mempty

path :: Path -> Poking
path :: Path -> Poking
path (Path Vector PathSegment
pathSegmentVector) =
  (PathSegment -> Poking) -> Poking -> Vector PathSegment -> Poking
forall monoid element.
Monoid monoid =>
(element -> monoid) -> monoid -> Vector element -> monoid
F.intercalate PathSegment -> Poking
pathSegment (Char -> Poking
asciiChar Char
'/') Vector PathSegment
pathSegmentVector

pathSegment :: PathSegment -> Poking
pathSegment :: PathSegment -> Poking
pathSegment (PathSegment ByteString
value) =
  Predicate -> ByteString -> Poking
urlEncodedBytes Predicate
I.unencodedPathSegment ByteString
value

query :: Query -> Poking
query :: Query -> Poking
query (Query ByteString
value) =
  Predicate -> ByteString -> Poking
urlEncodedBytes Predicate
I.unencodedQuery ByteString
value

fragment :: Fragment -> Poking
fragment :: Fragment -> Poking
fragment (Fragment ByteString
value) =
  Predicate -> ByteString -> Poking
urlEncodedBytes Predicate
I.unencodedFragment ByteString
value

urlEncodedBytes :: I.Predicate -> ByteString -> Poking
urlEncodedBytes :: Predicate -> ByteString -> Poking
urlEncodedBytes Predicate
unencodedPredicate =
  (Poking -> Word8 -> Poking) -> Poking -> ByteString -> Poking
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
ByteString.foldl' (\Poking
poking -> Poking -> Poking -> Poking
forall a. Monoid a => a -> a -> a
mappend Poking
poking (Poking -> Poking) -> (Word8 -> Poking) -> Word8 -> Poking
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word8 -> Poking
byte) Poking
forall a. Monoid a => a
mempty
  where
    byte :: Word8 -> Poking
byte Word8
x =
      if Predicate
unencodedPredicate (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x)
        then Word8 -> Poking
word8 Word8
x
        else Word8 -> Poking
urlEncodedByte Word8
x

-- | Apply URL-encoding to text
urlEncodedText :: I.Predicate -> Text -> Poking
urlEncodedText :: Predicate -> Text -> Poking
urlEncodedText Predicate
unencodedPredicate =
  (Poking -> Char -> Poking) -> Poking -> Text -> Poking
forall a. (a -> Char -> a) -> a -> Text -> a
C.foldl' (\Poking
poking -> Poking -> Poking -> Poking
forall a. Monoid a => a -> a -> a
mappend Poking
poking (Poking -> Poking) -> (Char -> Poking) -> Char -> Poking
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Predicate -> Int -> Poking
urlEncodedUnicodeCodePoint Predicate
unencodedPredicate (Int -> Poking) -> (Char -> Int) -> Char -> Poking
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Int
ord) Poking
forall a. Monoid a => a
mempty

urlEncodedUnicodeCodePoint :: I.Predicate -> Int -> Poking
urlEncodedUnicodeCodePoint :: Predicate -> Int -> Poking
urlEncodedUnicodeCodePoint Predicate
unencodedPredicate Int
codePoint =
  Int -> Utf8CodePoint
K.unicodeCodePoint
    Int
codePoint
    (\Word8
b1 -> if Predicate
unencodedPredicate Int
codePoint then Word8 -> Poking
word8 Word8
b1 else Word8 -> Poking
urlEncodedByte Word8
b1)
    (\Word8
b1 Word8
b2 -> Word8 -> Poking
urlEncodedByte Word8
b1 Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Word8 -> Poking
urlEncodedByte Word8
b2)
    (\Word8
b1 Word8
b2 Word8
b3 -> Word8 -> Poking
urlEncodedByte Word8
b1 Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Word8 -> Poking
urlEncodedByte Word8
b2 Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Word8 -> Poking
urlEncodedByte Word8
b3)
    (\Word8
b1 Word8
b2 Word8
b3 Word8
b4 -> Word8 -> Poking
urlEncodedByte Word8
b1 Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Word8 -> Poking
urlEncodedByte Word8
b2 Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Word8 -> Poking
urlEncodedByte Word8
b3 Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Word8 -> Poking
urlEncodedByte Word8
b4)

urlEncodedByte :: Word8 -> Poking
urlEncodedByte :: Word8 -> Poking
urlEncodedByte =
  Poke Word8 -> Word8 -> Poking
forall input. Poke input -> input -> Poking
poke Poke Word8
L.urlEncodedByte

prependIfNotNull :: Poking -> Poking -> Poking
prependIfNotNull :: Poking -> Poking -> Poking
prependIfNotNull Poking
prepended Poking
it =
  if Poking -> Bool
null Poking
it
    then Poking
forall a. Monoid a => a
mempty
    else Poking
prepended Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Poking
it

appendIfNotNull :: Poking -> Poking -> Poking
appendIfNotNull :: Poking -> Poking -> Poking
appendIfNotNull Poking
appended Poking
it =
  if Poking -> Bool
null Poking
it
    then Poking
forall a. Monoid a => a
mempty
    else Poking
it Poking -> Poking -> Poking
forall a. Semigroup a => a -> a -> a
<> Poking
appended