{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoFieldSelectors #-}

module WikiMusic.Free.UserCommand
  ( UserCommand (..),
    makeResetPasswordLink,
    changePasswordByEmail,
    invalidateResetTokenByEmail,
    inviteUser,
    deleteUser,
    UserCommandError (..),
    UserEmail (..),
    UserPassword (..),
    UserName (..),
  )
where

import WikiMusic.Protolude

newtype UserEmail = UserEmail {UserEmail -> Text
value :: Text}
  deriving ((forall x. UserEmail -> Rep UserEmail x)
-> (forall x. Rep UserEmail x -> UserEmail) -> Generic UserEmail
forall x. Rep UserEmail x -> UserEmail
forall x. UserEmail -> Rep UserEmail x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserEmail -> Rep UserEmail x
from :: forall x. UserEmail -> Rep UserEmail x
$cto :: forall x. Rep UserEmail x -> UserEmail
to :: forall x. Rep UserEmail x -> UserEmail
Generic, UserEmail -> UserEmail -> Bool
(UserEmail -> UserEmail -> Bool)
-> (UserEmail -> UserEmail -> Bool) -> Eq UserEmail
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserEmail -> UserEmail -> Bool
== :: UserEmail -> UserEmail -> Bool
$c/= :: UserEmail -> UserEmail -> Bool
/= :: UserEmail -> UserEmail -> Bool
Eq, Int -> UserEmail -> ShowS
[UserEmail] -> ShowS
UserEmail -> String
(Int -> UserEmail -> ShowS)
-> (UserEmail -> String)
-> ([UserEmail] -> ShowS)
-> Show UserEmail
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserEmail -> ShowS
showsPrec :: Int -> UserEmail -> ShowS
$cshow :: UserEmail -> String
show :: UserEmail -> String
$cshowList :: [UserEmail] -> ShowS
showList :: [UserEmail] -> ShowS
Show)

makeFieldLabelsNoPrefix ''UserEmail

newtype UserPassword = UserPassword {UserPassword -> Text
value :: Text}
  deriving ((forall x. UserPassword -> Rep UserPassword x)
-> (forall x. Rep UserPassword x -> UserPassword)
-> Generic UserPassword
forall x. Rep UserPassword x -> UserPassword
forall x. UserPassword -> Rep UserPassword x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserPassword -> Rep UserPassword x
from :: forall x. UserPassword -> Rep UserPassword x
$cto :: forall x. Rep UserPassword x -> UserPassword
to :: forall x. Rep UserPassword x -> UserPassword
Generic, UserPassword -> UserPassword -> Bool
(UserPassword -> UserPassword -> Bool)
-> (UserPassword -> UserPassword -> Bool) -> Eq UserPassword
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserPassword -> UserPassword -> Bool
== :: UserPassword -> UserPassword -> Bool
$c/= :: UserPassword -> UserPassword -> Bool
/= :: UserPassword -> UserPassword -> Bool
Eq, Int -> UserPassword -> ShowS
[UserPassword] -> ShowS
UserPassword -> String
(Int -> UserPassword -> ShowS)
-> (UserPassword -> String)
-> ([UserPassword] -> ShowS)
-> Show UserPassword
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserPassword -> ShowS
showsPrec :: Int -> UserPassword -> ShowS
$cshow :: UserPassword -> String
show :: UserPassword -> String
$cshowList :: [UserPassword] -> ShowS
showList :: [UserPassword] -> ShowS
Show)

makeFieldLabelsNoPrefix ''UserPassword

newtype UserName = UserName {UserName -> Text
value :: Text}
  deriving ((forall x. UserName -> Rep UserName x)
-> (forall x. Rep UserName x -> UserName) -> Generic UserName
forall x. Rep UserName x -> UserName
forall x. UserName -> Rep UserName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserName -> Rep UserName x
from :: forall x. UserName -> Rep UserName x
$cto :: forall x. Rep UserName x -> UserName
to :: forall x. Rep UserName x -> UserName
Generic, UserName -> UserName -> Bool
(UserName -> UserName -> Bool)
-> (UserName -> UserName -> Bool) -> Eq UserName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserName -> UserName -> Bool
== :: UserName -> UserName -> Bool
$c/= :: UserName -> UserName -> Bool
/= :: UserName -> UserName -> Bool
Eq, Int -> UserName -> ShowS
[UserName] -> ShowS
UserName -> String
(Int -> UserName -> ShowS)
-> (UserName -> String) -> ([UserName] -> ShowS) -> Show UserName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserName -> ShowS
showsPrec :: Int -> UserName -> ShowS
$cshow :: UserName -> String
show :: UserName -> String
$cshowList :: [UserName] -> ShowS
showList :: [UserName] -> ShowS
Show)

makeFieldLabelsNoPrefix ''UserName

data UserCommandError = PersistenceError Text | LogicError Text | NotificationError Text
  deriving (Int -> UserCommandError -> ShowS
[UserCommandError] -> ShowS
UserCommandError -> String
(Int -> UserCommandError -> ShowS)
-> (UserCommandError -> String)
-> ([UserCommandError] -> ShowS)
-> Show UserCommandError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserCommandError -> ShowS
showsPrec :: Int -> UserCommandError -> ShowS
$cshow :: UserCommandError -> String
show :: UserCommandError -> String
$cshowList :: [UserCommandError] -> ShowS
showList :: [UserCommandError] -> ShowS
Show)

type UserCommand :: Type -> Type
data UserCommand a
  = MakeResetPasswordLink Env UserEmail (Either UserCommandError Text -> a)
  | ChangePasswordByEmail Env UserEmail UserPassword (Either UserCommandError () -> a)
  | InvalidateResetTokenByEmail Env UserEmail (Either UserCommandError () -> a)
  | InviteUser Env WikiMusicUser UserEmail UserName UserRole (Maybe Text) (Either UserCommandError Text -> a)
  | DeleteUser Env WikiMusicUser UserEmail (Either UserCommandError () -> a)
  deriving ((forall a b. (a -> b) -> UserCommand a -> UserCommand b)
-> (forall a b. a -> UserCommand b -> UserCommand a)
-> Functor UserCommand
forall a b. a -> UserCommand b -> UserCommand a
forall a b. (a -> b) -> UserCommand a -> UserCommand b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> UserCommand a -> UserCommand b
fmap :: forall a b. (a -> b) -> UserCommand a -> UserCommand b
$c<$ :: forall a b. a -> UserCommand b -> UserCommand a
<$ :: forall a b. a -> UserCommand b -> UserCommand a
Functor)

makeResetPasswordLink :: (UserCommand :<: f) => Env -> UserEmail -> Free f (Either UserCommandError Text)
makeResetPasswordLink :: forall (f :: * -> *).
(UserCommand :<: f) =>
Env -> UserEmail -> Free f (Either UserCommandError Text)
makeResetPasswordLink Env
env UserEmail
userEmail = UserCommand (Free f (Either UserCommandError Text))
-> Free f (Either UserCommandError Text)
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> UserEmail
-> (Either UserCommandError Text
    -> Free f (Either UserCommandError Text))
-> UserCommand (Free f (Either UserCommandError Text))
forall a.
Env
-> UserEmail
-> (Either UserCommandError Text -> a)
-> UserCommand a
MakeResetPasswordLink Env
env UserEmail
userEmail Either UserCommandError Text
-> Free f (Either UserCommandError Text)
forall (f :: * -> *) a. a -> Free f a
Pure)

changePasswordByEmail :: (UserCommand :<: f) => Env -> UserEmail -> UserPassword -> Free f (Either UserCommandError ())
changePasswordByEmail :: forall (f :: * -> *).
(UserCommand :<: f) =>
Env
-> UserEmail -> UserPassword -> Free f (Either UserCommandError ())
changePasswordByEmail Env
env UserEmail
userEmail UserPassword
userPass = UserCommand (Free f (Either UserCommandError ()))
-> Free f (Either UserCommandError ())
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> UserEmail
-> UserPassword
-> (Either UserCommandError ()
    -> Free f (Either UserCommandError ()))
-> UserCommand (Free f (Either UserCommandError ()))
forall a.
Env
-> UserEmail
-> UserPassword
-> (Either UserCommandError () -> a)
-> UserCommand a
ChangePasswordByEmail Env
env UserEmail
userEmail UserPassword
userPass Either UserCommandError () -> Free f (Either UserCommandError ())
forall (f :: * -> *) a. a -> Free f a
Pure)

invalidateResetTokenByEmail :: (UserCommand :<: f) => Env -> UserEmail -> Free f (Either UserCommandError ())
invalidateResetTokenByEmail :: forall (f :: * -> *).
(UserCommand :<: f) =>
Env -> UserEmail -> Free f (Either UserCommandError ())
invalidateResetTokenByEmail Env
env UserEmail
userEmail = UserCommand (Free f (Either UserCommandError ()))
-> Free f (Either UserCommandError ())
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> UserEmail
-> (Either UserCommandError ()
    -> Free f (Either UserCommandError ()))
-> UserCommand (Free f (Either UserCommandError ()))
forall a.
Env
-> UserEmail -> (Either UserCommandError () -> a) -> UserCommand a
InvalidateResetTokenByEmail Env
env UserEmail
userEmail Either UserCommandError () -> Free f (Either UserCommandError ())
forall (f :: * -> *) a. a -> Free f a
Pure)

inviteUser :: (UserCommand :<: f) => Env -> WikiMusicUser -> UserEmail -> UserName -> UserRole -> Maybe Text -> Free f (Either UserCommandError Text)
inviteUser :: forall (f :: * -> *).
(UserCommand :<: f) =>
Env
-> WikiMusicUser
-> UserEmail
-> UserName
-> UserRole
-> Maybe Text
-> Free f (Either UserCommandError Text)
inviteUser Env
env WikiMusicUser
authUser UserEmail
userEmail UserName
userName UserRole
userRole Maybe Text
desc = UserCommand (Free f (Either UserCommandError Text))
-> Free f (Either UserCommandError Text)
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> WikiMusicUser
-> UserEmail
-> UserName
-> UserRole
-> Maybe Text
-> (Either UserCommandError Text
    -> Free f (Either UserCommandError Text))
-> UserCommand (Free f (Either UserCommandError Text))
forall a.
Env
-> WikiMusicUser
-> UserEmail
-> UserName
-> UserRole
-> Maybe Text
-> (Either UserCommandError Text -> a)
-> UserCommand a
InviteUser Env
env WikiMusicUser
authUser UserEmail
userEmail UserName
userName UserRole
userRole Maybe Text
desc Either UserCommandError Text
-> Free f (Either UserCommandError Text)
forall (f :: * -> *) a. a -> Free f a
Pure)

deleteUser :: (UserCommand :<: f) => Env -> WikiMusicUser -> UserEmail -> Free f (Either UserCommandError ())
deleteUser :: forall (f :: * -> *).
(UserCommand :<: f) =>
Env
-> WikiMusicUser
-> UserEmail
-> Free f (Either UserCommandError ())
deleteUser Env
env WikiMusicUser
authUser UserEmail
userEmail = UserCommand (Free f (Either UserCommandError ()))
-> Free f (Either UserCommandError ())
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> WikiMusicUser
-> UserEmail
-> (Either UserCommandError ()
    -> Free f (Either UserCommandError ()))
-> UserCommand (Free f (Either UserCommandError ()))
forall a.
Env
-> WikiMusicUser
-> UserEmail
-> (Either UserCommandError () -> a)
-> UserCommand a
DeleteUser Env
env WikiMusicUser
authUser UserEmail
userEmail Either UserCommandError () -> Free f (Either UserCommandError ())
forall (f :: * -> *) a. a -> Free f a
Pure)