-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Network.Wai.Utilities.Headers where

import Data.ByteString
import Data.ByteString.Conversion (FromByteString (..), ToByteString (..), fromByteString', toByteString')
import Data.OpenApi.ParamSchema (ToParamSchema (..))
import Data.Text as T
import Data.Text.Encoding
import Data.Text.Encoding.Error
import Imports
import Servant (FromHttpApiData (..), Proxy (Proxy), ToHttpApiData (..))

data CacheControl = NoStore
  deriving (CacheControl -> CacheControl -> Bool
(CacheControl -> CacheControl -> Bool)
-> (CacheControl -> CacheControl -> Bool) -> Eq CacheControl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CacheControl -> CacheControl -> Bool
== :: CacheControl -> CacheControl -> Bool
$c/= :: CacheControl -> CacheControl -> Bool
/= :: CacheControl -> CacheControl -> Bool
Eq, Int -> CacheControl -> ShowS
[CacheControl] -> ShowS
CacheControl -> String
(Int -> CacheControl -> ShowS)
-> (CacheControl -> String)
-> ([CacheControl] -> ShowS)
-> Show CacheControl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CacheControl -> ShowS
showsPrec :: Int -> CacheControl -> ShowS
$cshow :: CacheControl -> String
show :: CacheControl -> String
$cshowList :: [CacheControl] -> ShowS
showList :: [CacheControl] -> ShowS
Show, (forall x. CacheControl -> Rep CacheControl x)
-> (forall x. Rep CacheControl x -> CacheControl)
-> Generic CacheControl
forall x. Rep CacheControl x -> CacheControl
forall x. CacheControl -> Rep CacheControl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CacheControl -> Rep CacheControl x
from :: forall x. CacheControl -> Rep CacheControl x
$cto :: forall x. Rep CacheControl x -> CacheControl
to :: forall x. Rep CacheControl x -> CacheControl
Generic)

instance ToByteString CacheControl where
  builder :: CacheControl -> Builder
builder CacheControl
NoStore = Builder
"no-store"

instance FromByteString CacheControl where
  parser :: Parser CacheControl
parser = do
    Text
t :: Text <- Parser Text
forall a. FromByteString a => Parser a
parser
    case Text
t Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text
T.toLower of
      Text
"no-store" -> CacheControl -> Parser CacheControl
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CacheControl
NoStore
      Text
_ -> String -> Parser CacheControl
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser CacheControl) -> String -> Parser CacheControl
forall a b. (a -> b) -> a -> b
$ String
"Invalid CacheControl type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t

instance ToHttpApiData CacheControl where
  toQueryParam :: CacheControl -> Text
toQueryParam = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode (ByteString -> Text)
-> (CacheControl -> ByteString) -> CacheControl -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CacheControl -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString'

instance FromHttpApiData CacheControl where
  parseQueryParam :: Text -> Either Text CacheControl
parseQueryParam =
    Either Text CacheControl
-> (CacheControl -> Either Text CacheControl)
-> Maybe CacheControl
-> Either Text CacheControl
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text CacheControl
forall a b. a -> Either a b
Left Text
"Invalid CacheControl") CacheControl -> Either Text CacheControl
forall a b. b -> Either a b
Right
      (Maybe CacheControl -> Either Text CacheControl)
-> (Text -> Maybe CacheControl) -> Text -> Either Text CacheControl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe CacheControl
forall a. FromByteString a => ByteString -> Maybe a
fromByteString'
      (ByteString -> Maybe CacheControl)
-> (Text -> ByteString) -> Text -> Maybe CacheControl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict
      (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

instance ToParamSchema CacheControl where
  toParamSchema :: Proxy CacheControl -> Schema
toParamSchema Proxy CacheControl
_ = Proxy Text -> Schema
forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Text)