{-# LANGUAGE QuasiQuotes #-}

-- 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 Web.Scim.Schema.AuthenticationScheme
  ( AuthenticationScheme (..),
    AuthenticationSchemeEncoding (..),
    authHttpBasicEncoding,
  )
where

import Data.Aeson
import Data.Text
import GHC.Generics
import Network.URI.Static
import Web.Scim.Schema.Common

----------------------------------------------------------------------------
-- Types

-- | Possible authentication schemes. The specification defines the values
-- "oauth", "oauth2", "oauthbearertoken", "httpbasic", and "httpdigest".
data AuthenticationScheme
  = AuthOAuth
  | AuthOAuth2
  | AuthOAuthBearerToken
  | AuthHttpBasic
  | AuthHttpDigest
  deriving (AuthenticationScheme -> AuthenticationScheme -> Bool
(AuthenticationScheme -> AuthenticationScheme -> Bool)
-> (AuthenticationScheme -> AuthenticationScheme -> Bool)
-> Eq AuthenticationScheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthenticationScheme -> AuthenticationScheme -> Bool
== :: AuthenticationScheme -> AuthenticationScheme -> Bool
$c/= :: AuthenticationScheme -> AuthenticationScheme -> Bool
/= :: AuthenticationScheme -> AuthenticationScheme -> Bool
Eq, Int -> AuthenticationScheme -> ShowS
[AuthenticationScheme] -> ShowS
AuthenticationScheme -> String
(Int -> AuthenticationScheme -> ShowS)
-> (AuthenticationScheme -> String)
-> ([AuthenticationScheme] -> ShowS)
-> Show AuthenticationScheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthenticationScheme -> ShowS
showsPrec :: Int -> AuthenticationScheme -> ShowS
$cshow :: AuthenticationScheme -> String
show :: AuthenticationScheme -> String
$cshowList :: [AuthenticationScheme] -> ShowS
showList :: [AuthenticationScheme] -> ShowS
Show, Int -> AuthenticationScheme
AuthenticationScheme -> Int
AuthenticationScheme -> [AuthenticationScheme]
AuthenticationScheme -> AuthenticationScheme
AuthenticationScheme
-> AuthenticationScheme -> [AuthenticationScheme]
AuthenticationScheme
-> AuthenticationScheme
-> AuthenticationScheme
-> [AuthenticationScheme]
(AuthenticationScheme -> AuthenticationScheme)
-> (AuthenticationScheme -> AuthenticationScheme)
-> (Int -> AuthenticationScheme)
-> (AuthenticationScheme -> Int)
-> (AuthenticationScheme -> [AuthenticationScheme])
-> (AuthenticationScheme
    -> AuthenticationScheme -> [AuthenticationScheme])
-> (AuthenticationScheme
    -> AuthenticationScheme -> [AuthenticationScheme])
-> (AuthenticationScheme
    -> AuthenticationScheme
    -> AuthenticationScheme
    -> [AuthenticationScheme])
-> Enum AuthenticationScheme
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: AuthenticationScheme -> AuthenticationScheme
succ :: AuthenticationScheme -> AuthenticationScheme
$cpred :: AuthenticationScheme -> AuthenticationScheme
pred :: AuthenticationScheme -> AuthenticationScheme
$ctoEnum :: Int -> AuthenticationScheme
toEnum :: Int -> AuthenticationScheme
$cfromEnum :: AuthenticationScheme -> Int
fromEnum :: AuthenticationScheme -> Int
$cenumFrom :: AuthenticationScheme -> [AuthenticationScheme]
enumFrom :: AuthenticationScheme -> [AuthenticationScheme]
$cenumFromThen :: AuthenticationScheme
-> AuthenticationScheme -> [AuthenticationScheme]
enumFromThen :: AuthenticationScheme
-> AuthenticationScheme -> [AuthenticationScheme]
$cenumFromTo :: AuthenticationScheme
-> AuthenticationScheme -> [AuthenticationScheme]
enumFromTo :: AuthenticationScheme
-> AuthenticationScheme -> [AuthenticationScheme]
$cenumFromThenTo :: AuthenticationScheme
-> AuthenticationScheme
-> AuthenticationScheme
-> [AuthenticationScheme]
enumFromThenTo :: AuthenticationScheme
-> AuthenticationScheme
-> AuthenticationScheme
-> [AuthenticationScheme]
Enum, AuthenticationScheme
AuthenticationScheme
-> AuthenticationScheme -> Bounded AuthenticationScheme
forall a. a -> a -> Bounded a
$cminBound :: AuthenticationScheme
minBound :: AuthenticationScheme
$cmaxBound :: AuthenticationScheme
maxBound :: AuthenticationScheme
Bounded, Eq AuthenticationScheme
Eq AuthenticationScheme =>
(AuthenticationScheme -> AuthenticationScheme -> Ordering)
-> (AuthenticationScheme -> AuthenticationScheme -> Bool)
-> (AuthenticationScheme -> AuthenticationScheme -> Bool)
-> (AuthenticationScheme -> AuthenticationScheme -> Bool)
-> (AuthenticationScheme -> AuthenticationScheme -> Bool)
-> (AuthenticationScheme
    -> AuthenticationScheme -> AuthenticationScheme)
-> (AuthenticationScheme
    -> AuthenticationScheme -> AuthenticationScheme)
-> Ord AuthenticationScheme
AuthenticationScheme -> AuthenticationScheme -> Bool
AuthenticationScheme -> AuthenticationScheme -> Ordering
AuthenticationScheme
-> AuthenticationScheme -> AuthenticationScheme
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 :: AuthenticationScheme -> AuthenticationScheme -> Ordering
compare :: AuthenticationScheme -> AuthenticationScheme -> Ordering
$c< :: AuthenticationScheme -> AuthenticationScheme -> Bool
< :: AuthenticationScheme -> AuthenticationScheme -> Bool
$c<= :: AuthenticationScheme -> AuthenticationScheme -> Bool
<= :: AuthenticationScheme -> AuthenticationScheme -> Bool
$c> :: AuthenticationScheme -> AuthenticationScheme -> Bool
> :: AuthenticationScheme -> AuthenticationScheme -> Bool
$c>= :: AuthenticationScheme -> AuthenticationScheme -> Bool
>= :: AuthenticationScheme -> AuthenticationScheme -> Bool
$cmax :: AuthenticationScheme
-> AuthenticationScheme -> AuthenticationScheme
max :: AuthenticationScheme
-> AuthenticationScheme -> AuthenticationScheme
$cmin :: AuthenticationScheme
-> AuthenticationScheme -> AuthenticationScheme
min :: AuthenticationScheme
-> AuthenticationScheme -> AuthenticationScheme
Ord)

-- | The way authentication schemes are expected to be represented in the
-- configuration. Each 'AuthenticationScheme' corresponds to one of such
-- encodings.
data AuthenticationSchemeEncoding = AuthenticationSchemeEncoding
  { -- | The authentication scheme
    AuthenticationSchemeEncoding -> Text
typ :: Text,
    -- | The common authentication scheme name, e.g. HTTP Basic
    AuthenticationSchemeEncoding -> Text
name :: Text,
    -- | A description of the authentication scheme
    AuthenticationSchemeEncoding -> Text
description :: Text,
    -- | An HTTP-addressable URL pointing to the authentication scheme's
    -- specification
    AuthenticationSchemeEncoding -> Maybe URI
specUri :: Maybe URI,
    -- | An HTTP-addressable URL pointing to the authentication scheme's usage
    -- documentation
    AuthenticationSchemeEncoding -> Maybe URI
documentationUri :: Maybe URI
  }
  deriving (Int -> AuthenticationSchemeEncoding -> ShowS
[AuthenticationSchemeEncoding] -> ShowS
AuthenticationSchemeEncoding -> String
(Int -> AuthenticationSchemeEncoding -> ShowS)
-> (AuthenticationSchemeEncoding -> String)
-> ([AuthenticationSchemeEncoding] -> ShowS)
-> Show AuthenticationSchemeEncoding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthenticationSchemeEncoding -> ShowS
showsPrec :: Int -> AuthenticationSchemeEncoding -> ShowS
$cshow :: AuthenticationSchemeEncoding -> String
show :: AuthenticationSchemeEncoding -> String
$cshowList :: [AuthenticationSchemeEncoding] -> ShowS
showList :: [AuthenticationSchemeEncoding] -> ShowS
Show, AuthenticationSchemeEncoding
-> AuthenticationSchemeEncoding -> Bool
(AuthenticationSchemeEncoding
 -> AuthenticationSchemeEncoding -> Bool)
-> (AuthenticationSchemeEncoding
    -> AuthenticationSchemeEncoding -> Bool)
-> Eq AuthenticationSchemeEncoding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthenticationSchemeEncoding
-> AuthenticationSchemeEncoding -> Bool
== :: AuthenticationSchemeEncoding
-> AuthenticationSchemeEncoding -> Bool
$c/= :: AuthenticationSchemeEncoding
-> AuthenticationSchemeEncoding -> Bool
/= :: AuthenticationSchemeEncoding
-> AuthenticationSchemeEncoding -> Bool
Eq, (forall x.
 AuthenticationSchemeEncoding -> Rep AuthenticationSchemeEncoding x)
-> (forall x.
    Rep AuthenticationSchemeEncoding x -> AuthenticationSchemeEncoding)
-> Generic AuthenticationSchemeEncoding
forall x.
Rep AuthenticationSchemeEncoding x -> AuthenticationSchemeEncoding
forall x.
AuthenticationSchemeEncoding -> Rep AuthenticationSchemeEncoding x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
AuthenticationSchemeEncoding -> Rep AuthenticationSchemeEncoding x
from :: forall x.
AuthenticationSchemeEncoding -> Rep AuthenticationSchemeEncoding x
$cto :: forall x.
Rep AuthenticationSchemeEncoding x -> AuthenticationSchemeEncoding
to :: forall x.
Rep AuthenticationSchemeEncoding x -> AuthenticationSchemeEncoding
Generic)

instance ToJSON AuthenticationSchemeEncoding where
  toJSON :: AuthenticationSchemeEncoding -> Value
toJSON = Options -> AuthenticationSchemeEncoding -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
serializeOptions

instance FromJSON AuthenticationSchemeEncoding where
  -- NB: "typ" will be converted to "type" thanks to 'serializeOptions'
  parseJSON :: Value -> Parser AuthenticationSchemeEncoding
parseJSON = ([Text] -> Parser AuthenticationSchemeEncoding)
-> (Value -> Parser AuthenticationSchemeEncoding)
-> Either [Text] Value
-> Parser AuthenticationSchemeEncoding
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser AuthenticationSchemeEncoding
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser AuthenticationSchemeEncoding)
-> ([Text] -> String)
-> [Text]
-> Parser AuthenticationSchemeEncoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> String
forall a. Show a => a -> String
show) (Options -> Value -> Parser AuthenticationSchemeEncoding
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
parseOptions) (Either [Text] Value -> Parser AuthenticationSchemeEncoding)
-> (Value -> Either [Text] Value)
-> Value
-> Parser AuthenticationSchemeEncoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either [Text] Value
forall (m :: * -> *). (m ~ Either [Text]) => Value -> m Value
jsonLower

----------------------------------------------------------------------------
-- Scheme encodings

-- | The description of the 'AuthHttpBasic' scheme.
authHttpBasicEncoding :: AuthenticationSchemeEncoding
authHttpBasicEncoding :: AuthenticationSchemeEncoding
authHttpBasicEncoding =
  AuthenticationSchemeEncoding
    { typ :: Text
typ = Text
"httpbasic",
      name :: Text
name = Text
"HTTP Basic",
      description :: Text
description = Text
"Authentication via the HTTP Basic standard",
      specUri :: Maybe URI
specUri = URI -> Maybe URI
forall a. a -> Maybe a
Just (URI -> Maybe URI) -> URI -> Maybe URI
forall a b. (a -> b) -> a -> b
$ URI -> URI
URI [uri|https://tools.ietf.org/html/rfc7617|],
      documentationUri :: Maybe URI
documentationUri = URI -> Maybe URI
forall a. a -> Maybe a
Just (URI -> Maybe URI) -> URI -> Maybe URI
forall a b. (a -> b) -> a -> b
$ URI -> URI
URI [uri|https://en.wikipedia.org/wiki/Basic_access_authentication|]
    }