-- |
-- Module      : Amazonka.Data.Path
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Amazonka.Data.Path
  ( -- * Path Types
    Path (..),
    RawPath,
    EscapedPath,
    TwiceEscapedPath,

    -- * Constructing Paths
    ToPath (..),
    rawPath,

    -- * Manipulating Paths
    escapePath,
    escapePathTwice,
    collapsePath,
  )
where

import Amazonka.Data.ByteString
import Amazonka.Data.Text
import Amazonka.Prelude
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Network.HTTP.Types.URI as URI

class ToPath a where
  toPath :: a -> ByteString

instance ToPath ByteString where
  toPath :: ByteString -> ByteString
toPath = forall a. a -> a
id

instance ToPath Text where
  toPath :: Text -> ByteString
toPath = forall a. ToByteString a => a -> ByteString
toBS

rawPath :: ToPath a => a -> Path 'NoEncoding
rawPath :: forall a. ToPath a => a -> RawPath
rawPath = [ByteString] -> RawPath
Raw forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> [ByteString]
BS8.split Char
sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToPath a => a -> ByteString
toPath
  where
    strip :: [ByteString] -> [ByteString]
strip (ByteString
x : [ByteString]
xs)
      | ByteString -> Bool
BS.null ByteString
x = [ByteString]
xs
    strip [ByteString]
xs = [ByteString]
xs

data Encoding = NoEncoding | Percent
  deriving stock (Encoding -> Encoding -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Encoding -> Encoding -> Bool
$c/= :: Encoding -> Encoding -> Bool
== :: Encoding -> Encoding -> Bool
$c== :: Encoding -> Encoding -> Bool
Eq, Int -> Encoding -> ShowS
[Encoding] -> ShowS
Encoding -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Encoding] -> ShowS
$cshowList :: [Encoding] -> ShowS
show :: Encoding -> String
$cshow :: Encoding -> String
showsPrec :: Int -> Encoding -> ShowS
$cshowsPrec :: Int -> Encoding -> ShowS
Show)

data Path :: Encoding -> Type where
  Raw :: [ByteString] -> Path 'NoEncoding
  Encoded :: [ByteString] -> Path 'Percent

deriving stock instance Show (Path a)

deriving stock instance Eq (Path a)

type RawPath = Path 'NoEncoding

type EscapedPath = Path 'Percent

-- | Used in SigV4
newtype TwiceEscapedPath = TwiceEscapedPath (Path 'Percent)
  deriving newtype (TwiceEscapedPath -> TwiceEscapedPath -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TwiceEscapedPath -> TwiceEscapedPath -> Bool
$c/= :: TwiceEscapedPath -> TwiceEscapedPath -> Bool
== :: TwiceEscapedPath -> TwiceEscapedPath -> Bool
$c== :: TwiceEscapedPath -> TwiceEscapedPath -> Bool
Eq, Int -> TwiceEscapedPath -> ShowS
[TwiceEscapedPath] -> ShowS
TwiceEscapedPath -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TwiceEscapedPath] -> ShowS
$cshowList :: [TwiceEscapedPath] -> ShowS
show :: TwiceEscapedPath -> String
$cshow :: TwiceEscapedPath -> String
showsPrec :: Int -> TwiceEscapedPath -> ShowS
$cshowsPrec :: Int -> TwiceEscapedPath -> ShowS
Show, TwiceEscapedPath -> ByteString
forall a. (a -> ByteString) -> ToByteString a
toBS :: TwiceEscapedPath -> ByteString
$ctoBS :: TwiceEscapedPath -> ByteString
ToByteString)

instance Semigroup RawPath where
  Raw [ByteString]
xs <> :: RawPath -> RawPath -> RawPath
<> Raw [ByteString]
ys = [ByteString] -> RawPath
Raw ([ByteString]
xs forall a. [a] -> [a] -> [a]
++ [ByteString]
ys)

instance Monoid RawPath where
  mempty :: RawPath
mempty = [ByteString] -> RawPath
Raw []
  mappend :: RawPath -> RawPath -> RawPath
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance ToByteString EscapedPath where
  toBS :: Path 'Percent -> ByteString
toBS (Encoded []) = ByteString
slash
  toBS (Encoded [ByteString]
xs) = ByteString
slash forall a. Semigroup a => a -> a -> a
<> ByteString -> [ByteString] -> ByteString
BS8.intercalate ByteString
slash [ByteString]
xs

escapePath :: Path a -> EscapedPath
escapePath :: forall (a :: Encoding). Path a -> Path 'Percent
escapePath (Raw [ByteString]
xs) = [ByteString] -> Path 'Percent
Encoded (forall a b. (a -> b) -> [a] -> [b]
map (Bool -> ByteString -> ByteString
URI.urlEncode Bool
True) [ByteString]
xs)
escapePath (Encoded [ByteString]
xs) = [ByteString] -> Path 'Percent
Encoded [ByteString]
xs

-- | Escape a path twice. Used when computing the SigV4 canonical path.
escapePathTwice :: Path a -> TwiceEscapedPath
escapePathTwice :: forall (a :: Encoding). Path a -> TwiceEscapedPath
escapePathTwice Path a
p = Path 'Percent -> TwiceEscapedPath
TwiceEscapedPath forall a b. (a -> b) -> a -> b
$
  [ByteString] -> Path 'Percent
Encoded forall a b. (a -> b) -> a -> b
$ case Path a
p of
    Raw [ByteString]
xs -> forall a b. (a -> b) -> [a] -> [b]
map (Bool -> ByteString -> ByteString
URI.urlEncode Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ByteString -> ByteString
URI.urlEncode Bool
True) [ByteString]
xs
    Encoded [ByteString]
xs -> forall a b. (a -> b) -> [a] -> [b]
map (Bool -> ByteString -> ByteString
URI.urlEncode Bool
True) [ByteString]
xs

collapsePath :: Path a -> Path a
collapsePath :: forall (a :: Encoding). Path a -> Path a
collapsePath = \case
  Raw [ByteString]
xs -> [ByteString] -> RawPath
Raw ([ByteString] -> [ByteString]
go [ByteString]
xs)
  Encoded [ByteString]
xs -> [ByteString] -> Path 'Percent
Encoded ([ByteString] -> [ByteString]
go [ByteString]
xs)
  where
    go :: [ByteString] -> [ByteString]
go = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

    f :: [ByteString] -> [ByteString]
    f :: [ByteString] -> [ByteString]
f [] = []
    f (ByteString
x : [ByteString]
xs)
      | ByteString
x forall a. Eq a => a -> a -> Bool
== ByteString
dot = [ByteString] -> [ByteString]
f [ByteString]
xs
      | ByteString
x forall a. Eq a => a -> a -> Bool
== ByteString
dots = forall a. Int -> [a] -> [a]
drop Int
1 ([ByteString] -> [ByteString]
f [ByteString]
xs)
      | Bool
otherwise = ByteString
x forall a. a -> [a] -> [a]
: [ByteString] -> [ByteString]
f [ByteString]
xs

    dot :: ByteString
dot = ByteString
"."
    dots :: ByteString
dots = ByteString
".."

slash :: ByteString
slash :: ByteString
slash = Char -> ByteString
BS8.singleton Char
sep

sep :: Char
sep :: Char
sep = Char
'/'