diff --git a/UI/ReflexFRP/mockUsersRoles/mockAPI/mockAPI.cabal b/UI/ReflexFRP/mockUsersRoles/mockAPI/mockAPI.cabal index a02bcfc..90c56be 100644 --- a/UI/ReflexFRP/mockUsersRoles/mockAPI/mockAPI.cabal +++ b/UI/ReflexFRP/mockUsersRoles/mockAPI/mockAPI.cabal @@ -6,6 +6,7 @@ cabal-version: >=1.10 library hs-source-dirs: src exposed-modules: MockAPI + , ExRoles , GenericStructure , Permissions build-depends: base >= 4.7 && < 5 diff --git a/UI/ReflexFRP/mockUsersRoles/mockAPI/src/ExRoles.hs b/UI/ReflexFRP/mockUsersRoles/mockAPI/src/ExRoles.hs new file mode 100644 index 0000000..9698430 --- /dev/null +++ b/UI/ReflexFRP/mockUsersRoles/mockAPI/src/ExRoles.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE OverloadedStrings #-} + +module ExRoles where + +import MockAPI +import Permissions + +import Data.Set (Set) +import qualified Data.Set as Set + +import Data.Map (Map) +import qualified Data.Map as Map + +import Data.Monoid + +exRoles = Roles $ accountAdministrator <> productAdministrator <> productEditor + +allPermissions :: [Permission] +allPermissions = concat [ map PP [minBound .. maxBound] + , map OP [minBound .. maxBound] + , map UP [minBound .. maxBound] + ] + +accountAdministrator = Map.singleton "Account administrator" (RoleAttributes roles users) + where + roles = Set.fromList allPermissions + users = Set.fromList [ User "admin@mydomain.com" + , User "otheradmin@mydomain.com" + , User "yetanotheradmin@mydomain.com" + ] + +productAdministrator = Map.singleton "Product administrator" (RoleAttributes roles users) + where + roles = Set.fromList $ map PP [minBound .. maxBound] + users = Set.fromList [ User "user1@mydomain.com" + , User "user2@mydomain.com" + , User "user3@mydomain.com" + ] + +productEditor = Map.singleton "Product editor" (RoleAttributes roles users) + where + roles = Set.fromList $ map PP [ViewAllProductDetails, EditProdTextualContent, EditProdPhotos] + users = Set.fromList [ User "user4@mydomain.com" + , User "user5@mydomain.com" + , User "user6@mydomain.com" + , User "user7@mydomain.com" + , User "user8@mydomain.com" + , User "user9@mydomain.com" + , User "user10@mydomain.com" + , User "user11@mydomain.com" + ] diff --git a/UI/ReflexFRP/mockUsersRoles/mockAPI/src/MockAPI.hs b/UI/ReflexFRP/mockUsersRoles/mockAPI/src/MockAPI.hs index 45e23bd..b1e1b3f 100644 --- a/UI/ReflexFRP/mockUsersRoles/mockAPI/src/MockAPI.hs +++ b/UI/ReflexFRP/mockUsersRoles/mockAPI/src/MockAPI.hs @@ -20,10 +20,18 @@ import qualified Data.Map as Map import Permissions +type Email = Text + data User = User - { userMail :: Text + { userMail :: Email } deriving (Show, Eq, Ord, Generic) +instance FromHttpApiData User where + parseUrlPiece mail = Right (User mail) + +instance ToHttpApiData User where + toUrlPiece (User mail) = mail + instance ToJSON User instance FromJSON User @@ -45,18 +53,10 @@ instance Wrapped Roles where type Unwrapped Roles = Map RoleName RoleAttributes _Wrapped' = iso unRoles Roles -exRoles = Roles $ Map.singleton "Account administrator" (RoleAttributes roles users) - where - roles = Set.fromList [ PP ViewAllProductDetails ] - users = Set.fromList [ User "admin@mydomain.com" - , User "otheradmin@mydomain.com" - , User "yetanotheradmin@mydomain.com" - ] - instance ToJSON Roles instance FromJSON Roles -type MockApi = "deleteUserRole" :> ReqBody '[JSON] RoleName :> "user" :> ReqBody '[JSON] User :> Delete '[JSON] NoContent - :<|> "showRoles" :> Get '[JSON] Roles +type MockApi = "delete" :> Capture "role" RoleName :> Capture "user" User :> Delete '[JSON] NoContent + :<|> "roles" :> Get '[JSON] Roles :<|> "assets" :> Raw :<|> Raw diff --git a/UI/ReflexFRP/mockUsersRoles/mockAPI/src/Permissions.hs b/UI/ReflexFRP/mockUsersRoles/mockAPI/src/Permissions.hs index c5f1121..c49dd0a 100644 --- a/UI/ReflexFRP/mockUsersRoles/mockAPI/src/Permissions.hs +++ b/UI/ReflexFRP/mockUsersRoles/mockAPI/src/Permissions.hs @@ -15,10 +15,10 @@ data Permission = PP ProductPermission | OP OrderPermission | UP UserPermission data ProductPermission = ViewAllProductDetails | EditProdTextualContent - | EdidProdPhotos + | EditProdPhotos | EditProdProperties | EditProdPrice - deriving (Show, Eq, Ord, Generic) + deriving (Show, Eq, Ord, Generic, Bounded, Enum) data OrderPermission = ViewAllOrderDetails @@ -27,13 +27,13 @@ data OrderPermission | ApplyDiscounts | CancelOrder | ChangeOrderContactDetails - deriving (Show, Eq, Ord, Generic) + deriving (Show, Eq, Ord, Generic, Bounded, Enum) data UserPermission = ViewUserDetails | EditUserDetails | ChangeUserRole - deriving (Show, Eq, Ord, Generic) + deriving (Show, Eq, Ord, Generic, Bounded, Enum) -- Generated JSON instances @@ -55,7 +55,7 @@ class UserLabel a where instance UserLabel ProductPermission where toUserLabel ViewAllProductDetails = "View all product details" toUserLabel EditProdTextualContent = "Edit product textual content" - toUserLabel EdidProdPhotos = "Edit product photos" + toUserLabel EditProdPhotos = "Edit product photos" toUserLabel EditProdProperties = "Edit product properties" toUserLabel EditProdPrice = "Edit product price " @@ -71,3 +71,8 @@ instance UserLabel UserPermission where toUserLabel ViewUserDetails = "View user details" toUserLabel EditUserDetails = "Edit some other user's details" toUserLabel ChangeUserRole = "Change roles assigned to a user" + +instance UserLabel Permission where + toUserLabel (PP p) = toUserLabel p + toUserLabel (OP p) = toUserLabel p + toUserLabel (UP p) = toUserLabel p diff --git a/UI/ReflexFRP/mockUsersRoles/mockServer/Main.hs b/UI/ReflexFRP/mockUsersRoles/mockServer/Main.hs index da250fd..bd21ffb 100644 --- a/UI/ReflexFRP/mockUsersRoles/mockServer/Main.hs +++ b/UI/ReflexFRP/mockUsersRoles/mockServer/Main.hs @@ -7,6 +7,7 @@ module Main where import MockAPI +import ExRoles import Servant import Network.Wai.Handler.Warp import Network.Wai.Middleware.Gzip