{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoFieldSelectors #-}

module WikiMusic.Model.Auth
  ( WikiMusicUser (..),
    LoginRequest (..),
    UserRole (..),
    isAtLeastDemo,
    isAtLeastMaintainer,
    isAtLeastSuperUser,
    isAtLeastLowRank,
    doWithRoles,
    doWithRoles',
    Prelude.show,
    Prelude.read,
  )
where

import Data.Aeson
import Data.OpenApi
import Data.Text qualified as T
import Data.UUID qualified
import Optics
import Relude
import Text.Read
import Prelude qualified

data UserRole = SuperUser | Maintainer | LowRank | Demo
  deriving (UserRole -> UserRole -> Bool
(UserRole -> UserRole -> Bool)
-> (UserRole -> UserRole -> Bool) -> Eq UserRole
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserRole -> UserRole -> Bool
== :: UserRole -> UserRole -> Bool
$c/= :: UserRole -> UserRole -> Bool
/= :: UserRole -> UserRole -> Bool
Eq, (forall x. UserRole -> Rep UserRole x)
-> (forall x. Rep UserRole x -> UserRole) -> Generic UserRole
forall x. Rep UserRole x -> UserRole
forall x. UserRole -> Rep UserRole x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserRole -> Rep UserRole x
from :: forall x. UserRole -> Rep UserRole x
$cto :: forall x. Rep UserRole x -> UserRole
to :: forall x. Rep UserRole x -> UserRole
Generic, Typeable UserRole
Typeable UserRole =>
(Proxy UserRole -> Declare (Definitions Schema) NamedSchema)
-> ToSchema UserRole
Proxy UserRole -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy UserRole -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy UserRole -> Declare (Definitions Schema) NamedSchema
ToSchema)

instance FromJSON UserRole where
  parseJSON :: Value -> Parser UserRole
parseJSON (Data.Aeson.String Text
v) = UserRole -> Parser UserRole
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserRole -> Parser UserRole)
-> (Text -> UserRole) -> Text -> Parser UserRole
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UserRole
forall a. Read a => String -> a
read (String -> UserRole) -> (Text -> String) -> Text -> UserRole
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Parser UserRole) -> Text -> Parser UserRole
forall a b. (a -> b) -> a -> b
$ Text
v
  parseJSON Value
_ = Parser UserRole
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance ToJSON UserRole where
  toJSON :: UserRole -> Value
toJSON UserRole
SuperUser = Value
"wm::superuser"
  toJSON UserRole
Maintainer = Value
"wm::maintainer"
  toJSON UserRole
LowRank = Value
"wm::lowrank"
  toJSON UserRole
Demo = Value
"wm::demo"

instance Show UserRole where
  show :: UserRole -> String
show UserRole
SuperUser = String
"wm::superuser"
  show UserRole
Maintainer = String
"wm::maintainer"
  show UserRole
LowRank = String
"wm::lowrank"
  show UserRole
Demo = String
"wm::demo"

instance Read UserRole where
  readsPrec :: Int -> ReadS UserRole
readsPrec Int
_ String
"wm::superuser" = [(UserRole
SuperUser, String
"")]
  readsPrec Int
_ String
"wm::maintainer" = [(UserRole
Maintainer, String
"")]
  readsPrec Int
_ String
"wm::lowrank" = [(UserRole
LowRank, String
"")]
  readsPrec Int
_ String
"wm::demo" = [(UserRole
Demo, String
"")]
  readsPrec Int
_ String
_ = []

isAtLeastDemo :: [UserRole] -> Bool
isAtLeastDemo :: [UserRole] -> Bool
isAtLeastDemo [UserRole]
xs = UserRole -> [UserRole] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
elem UserRole
Demo [UserRole]
xs Bool -> Bool -> Bool
|| UserRole -> [UserRole] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
elem UserRole
LowRank [UserRole]
xs Bool -> Bool -> Bool
|| UserRole -> [UserRole] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
elem UserRole
Maintainer [UserRole]
xs Bool -> Bool -> Bool
|| UserRole -> [UserRole] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
elem UserRole
SuperUser [UserRole]
xs

isAtLeastLowRank :: [UserRole] -> Bool
isAtLeastLowRank :: [UserRole] -> Bool
isAtLeastLowRank [UserRole]
xs = UserRole -> [UserRole] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
elem UserRole
LowRank [UserRole]
xs Bool -> Bool -> Bool
|| UserRole -> [UserRole] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
elem UserRole
Maintainer [UserRole]
xs Bool -> Bool -> Bool
|| UserRole -> [UserRole] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
elem UserRole
SuperUser [UserRole]
xs

isAtLeastMaintainer :: [UserRole] -> Bool
isAtLeastMaintainer :: [UserRole] -> Bool
isAtLeastMaintainer [UserRole]
xs = UserRole -> [UserRole] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
elem UserRole
Maintainer [UserRole]
xs Bool -> Bool -> Bool
|| UserRole -> [UserRole] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
elem UserRole
SuperUser [UserRole]
xs

isAtLeastSuperUser :: [UserRole] -> Bool
isAtLeastSuperUser :: [UserRole] -> Bool
isAtLeastSuperUser = UserRole -> [UserRole] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
elem UserRole
SuperUser

doWithRoles :: (Applicative f) => t -> (t -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles :: forall (f :: * -> *) t p b.
Applicative f =>
t -> (t -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles t
roles t -> Bool
computeExpectation p
err f (Either p b)
eff = if t -> Bool
computeExpectation t
roles then f (Either p b)
eff else Either p b -> f (Either p b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either p b -> f (Either p b))
-> (p -> Either p b) -> p -> f (Either p b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> Either p b
forall a b. a -> Either a b
Left (p -> f (Either p b)) -> p -> f (Either p b)
forall a b. (a -> b) -> a -> b
$ p
err

doWithRoles' :: (Applicative f) => WikiMusicUser -> ([UserRole] -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles' :: forall (f :: * -> *) p b.
Applicative f =>
WikiMusicUser
-> ([UserRole] -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles' WikiMusicUser
authToken [UserRole] -> Bool
computeExpectation p
err f (Either p b)
eff = if [UserRole] -> Bool
computeExpectation (WikiMusicUser
authToken WikiMusicUser
-> Optic' A_Lens NoIx WikiMusicUser [UserRole] -> [UserRole]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx WikiMusicUser [UserRole]
#roles) then f (Either p b)
eff else Either p b -> f (Either p b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either p b -> f (Either p b))
-> (p -> Either p b) -> p -> f (Either p b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> Either p b
forall a b. a -> Either a b
Left (p -> f (Either p b)) -> p -> f (Either p b)
forall a b. (a -> b) -> a -> b
$ p
err

data WikiMusicUser = WikiMusicUser
  { WikiMusicUser -> UUID
identifier :: Data.UUID.UUID,
    WikiMusicUser -> Text
displayName :: Text,
    WikiMusicUser -> Text
emailAddress :: Text,
    WikiMusicUser -> Maybe Text
passwordHash :: Maybe Text,
    WikiMusicUser -> Maybe Text
authToken :: Maybe Text,
    WikiMusicUser -> [UserRole]
roles :: [UserRole]
  }
  deriving (WikiMusicUser -> WikiMusicUser -> Bool
(WikiMusicUser -> WikiMusicUser -> Bool)
-> (WikiMusicUser -> WikiMusicUser -> Bool) -> Eq WikiMusicUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WikiMusicUser -> WikiMusicUser -> Bool
== :: WikiMusicUser -> WikiMusicUser -> Bool
$c/= :: WikiMusicUser -> WikiMusicUser -> Bool
/= :: WikiMusicUser -> WikiMusicUser -> Bool
Eq, Int -> WikiMusicUser -> ShowS
[WikiMusicUser] -> ShowS
WikiMusicUser -> String
(Int -> WikiMusicUser -> ShowS)
-> (WikiMusicUser -> String)
-> ([WikiMusicUser] -> ShowS)
-> Show WikiMusicUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WikiMusicUser -> ShowS
showsPrec :: Int -> WikiMusicUser -> ShowS
$cshow :: WikiMusicUser -> String
show :: WikiMusicUser -> String
$cshowList :: [WikiMusicUser] -> ShowS
showList :: [WikiMusicUser] -> ShowS
Show, ReadPrec [WikiMusicUser]
ReadPrec WikiMusicUser
Int -> ReadS WikiMusicUser
ReadS [WikiMusicUser]
(Int -> ReadS WikiMusicUser)
-> ReadS [WikiMusicUser]
-> ReadPrec WikiMusicUser
-> ReadPrec [WikiMusicUser]
-> Read WikiMusicUser
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS WikiMusicUser
readsPrec :: Int -> ReadS WikiMusicUser
$creadList :: ReadS [WikiMusicUser]
readList :: ReadS [WikiMusicUser]
$creadPrec :: ReadPrec WikiMusicUser
readPrec :: ReadPrec WikiMusicUser
$creadListPrec :: ReadPrec [WikiMusicUser]
readListPrec :: ReadPrec [WikiMusicUser]
Read, (forall x. WikiMusicUser -> Rep WikiMusicUser x)
-> (forall x. Rep WikiMusicUser x -> WikiMusicUser)
-> Generic WikiMusicUser
forall x. Rep WikiMusicUser x -> WikiMusicUser
forall x. WikiMusicUser -> Rep WikiMusicUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WikiMusicUser -> Rep WikiMusicUser x
from :: forall x. WikiMusicUser -> Rep WikiMusicUser x
$cto :: forall x. Rep WikiMusicUser x -> WikiMusicUser
to :: forall x. Rep WikiMusicUser x -> WikiMusicUser
Generic, Maybe WikiMusicUser
Value -> Parser [WikiMusicUser]
Value -> Parser WikiMusicUser
(Value -> Parser WikiMusicUser)
-> (Value -> Parser [WikiMusicUser])
-> Maybe WikiMusicUser
-> FromJSON WikiMusicUser
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser WikiMusicUser
parseJSON :: Value -> Parser WikiMusicUser
$cparseJSONList :: Value -> Parser [WikiMusicUser]
parseJSONList :: Value -> Parser [WikiMusicUser]
$comittedField :: Maybe WikiMusicUser
omittedField :: Maybe WikiMusicUser
FromJSON, [WikiMusicUser] -> Value
[WikiMusicUser] -> Encoding
WikiMusicUser -> Bool
WikiMusicUser -> Value
WikiMusicUser -> Encoding
(WikiMusicUser -> Value)
-> (WikiMusicUser -> Encoding)
-> ([WikiMusicUser] -> Value)
-> ([WikiMusicUser] -> Encoding)
-> (WikiMusicUser -> Bool)
-> ToJSON WikiMusicUser
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: WikiMusicUser -> Value
toJSON :: WikiMusicUser -> Value
$ctoEncoding :: WikiMusicUser -> Encoding
toEncoding :: WikiMusicUser -> Encoding
$ctoJSONList :: [WikiMusicUser] -> Value
toJSONList :: [WikiMusicUser] -> Value
$ctoEncodingList :: [WikiMusicUser] -> Encoding
toEncodingList :: [WikiMusicUser] -> Encoding
$comitField :: WikiMusicUser -> Bool
omitField :: WikiMusicUser -> Bool
ToJSON)

makeFieldLabelsNoPrefix ''WikiMusicUser

data LoginRequest = LoginRequest
  { LoginRequest -> String
wikimusicEmail :: String,
    LoginRequest -> String
wikimusicPassword :: String
  }
  deriving (LoginRequest -> LoginRequest -> Bool
(LoginRequest -> LoginRequest -> Bool)
-> (LoginRequest -> LoginRequest -> Bool) -> Eq LoginRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LoginRequest -> LoginRequest -> Bool
== :: LoginRequest -> LoginRequest -> Bool
$c/= :: LoginRequest -> LoginRequest -> Bool
/= :: LoginRequest -> LoginRequest -> Bool
Eq, Int -> LoginRequest -> ShowS
[LoginRequest] -> ShowS
LoginRequest -> String
(Int -> LoginRequest -> ShowS)
-> (LoginRequest -> String)
-> ([LoginRequest] -> ShowS)
-> Show LoginRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LoginRequest -> ShowS
showsPrec :: Int -> LoginRequest -> ShowS
$cshow :: LoginRequest -> String
show :: LoginRequest -> String
$cshowList :: [LoginRequest] -> ShowS
showList :: [LoginRequest] -> ShowS
Show, ReadPrec [LoginRequest]
ReadPrec LoginRequest
Int -> ReadS LoginRequest
ReadS [LoginRequest]
(Int -> ReadS LoginRequest)
-> ReadS [LoginRequest]
-> ReadPrec LoginRequest
-> ReadPrec [LoginRequest]
-> Read LoginRequest
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS LoginRequest
readsPrec :: Int -> ReadS LoginRequest
$creadList :: ReadS [LoginRequest]
readList :: ReadS [LoginRequest]
$creadPrec :: ReadPrec LoginRequest
readPrec :: ReadPrec LoginRequest
$creadListPrec :: ReadPrec [LoginRequest]
readListPrec :: ReadPrec [LoginRequest]
Read, (forall x. LoginRequest -> Rep LoginRequest x)
-> (forall x. Rep LoginRequest x -> LoginRequest)
-> Generic LoginRequest
forall x. Rep LoginRequest x -> LoginRequest
forall x. LoginRequest -> Rep LoginRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LoginRequest -> Rep LoginRequest x
from :: forall x. LoginRequest -> Rep LoginRequest x
$cto :: forall x. Rep LoginRequest x -> LoginRequest
to :: forall x. Rep LoginRequest x -> LoginRequest
Generic, Maybe LoginRequest
Value -> Parser [LoginRequest]
Value -> Parser LoginRequest
(Value -> Parser LoginRequest)
-> (Value -> Parser [LoginRequest])
-> Maybe LoginRequest
-> FromJSON LoginRequest
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser LoginRequest
parseJSON :: Value -> Parser LoginRequest
$cparseJSONList :: Value -> Parser [LoginRequest]
parseJSONList :: Value -> Parser [LoginRequest]
$comittedField :: Maybe LoginRequest
omittedField :: Maybe LoginRequest
FromJSON, [LoginRequest] -> Value
[LoginRequest] -> Encoding
LoginRequest -> Bool
LoginRequest -> Value
LoginRequest -> Encoding
(LoginRequest -> Value)
-> (LoginRequest -> Encoding)
-> ([LoginRequest] -> Value)
-> ([LoginRequest] -> Encoding)
-> (LoginRequest -> Bool)
-> ToJSON LoginRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: LoginRequest -> Value
toJSON :: LoginRequest -> Value
$ctoEncoding :: LoginRequest -> Encoding
toEncoding :: LoginRequest -> Encoding
$ctoJSONList :: [LoginRequest] -> Value
toJSONList :: [LoginRequest] -> Value
$ctoEncodingList :: [LoginRequest] -> Encoding
toEncodingList :: [LoginRequest] -> Encoding
$comitField :: LoginRequest -> Bool
omitField :: LoginRequest -> Bool
ToJSON, Typeable LoginRequest
Typeable LoginRequest =>
(Proxy LoginRequest -> Declare (Definitions Schema) NamedSchema)
-> ToSchema LoginRequest
Proxy LoginRequest -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy LoginRequest -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy LoginRequest -> Declare (Definitions Schema) NamedSchema
ToSchema)

makeFieldLabelsNoPrefix ''LoginRequest