New persistent api and server

vacationlabs · Nov 3, 2016 · aa50f8c · aa50f8c
1 parent 1eae6fd
commit aa50f8c
Show file tree

Hide file tree

Showing 5 changed files with 74 additions and 16 deletions.
diff --git 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
@@ -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 "[email protected]"
+                         , User "[email protected]"
+                         , User "[email protected]"
+                         ]
+
+productAdministrator = Map.singleton "Product administrator" (RoleAttributes roles users)
+  where
+    roles = Set.fromList $ map PP [minBound .. maxBound]
+    users = Set.fromList [ User "[email protected]"
+                         , User "[email protected]"
+                         , User "[email protected]"
+                         ]
+
+productEditor = Map.singleton "Product editor" (RoleAttributes roles users)
+  where
+    roles = Set.fromList $ map PP [ViewAllProductDetails, EditProdTextualContent, EditProdPhotos]
+    users = Set.fromList [ User "[email protected]"
+                         , User "[email protected]"
+                         , User "[email protected]"
+                         , User "[email protected]"
+                         , User "[email protected]"
+                         , User "[email protected]"
+                         , User "[email protected]"
+                         , User "[email protected]"
+                         ]
diff --git 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 "[email protected]"
-                             , User "[email protected]"
-                             , User "[email protected]"
-                             ]
-
 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
@@ -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
@@ -7,6 +7,7 @@
 module Main where
 
 import MockAPI
+import ExRoles
 import Servant
 import Network.Wai.Handler.Warp
 import Network.Wai.Middleware.Gzip