From 67ad9c11761996d118d6945d5e31d90b112e0bc7 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Mon, 13 Aug 2018 11:49:05 +0200
Subject: [PATCH] Fix Course- & School-ids

Fixes #151
---
 src/CryptoID.hs           |  2 +-
 src/Handler/Course.hs     | 26 +++++++++++---------------
 src/Handler/Utils/Form.hs | 16 +++-------------
 3 files changed, 15 insertions(+), 29 deletions(-)

diff --git a/src/CryptoID.hs b/src/CryptoID.hs
index c0739843f..61fd5559c 100644
--- a/src/CryptoID.hs
+++ b/src/CryptoID.hs
@@ -55,7 +55,7 @@ instance (CI.FoldCase s, PathMultiPiece s) => PathMultiPiece (CI s) where
 decCryptoIDs [ ''SubmissionId
              , ''FileId
              , ''UserId
-             , ''CourseId
+             , ''SchoolId
              ]
 
 instance {-# OVERLAPS #-} namespace ~ CryptoIDNamespace (CI FilePath) SubmissionId => PathPiece (E.CryptoID namespace (CI FilePath)) where
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 05ae4e04b..c13399cef 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -345,11 +345,10 @@ courseEditHandler isGet course = do
               addMessageI "danger" $ MsgCourseNewDupShort tid csh
 
       (FormSuccess res@(
-        CourseForm  { cfCourseId = Just cID
+        CourseForm  { cfCourseId = Just cid
                     , cfShort    = csh
                     , cfTerm     = tid
                     })) -> do -- edit existing course
-          cid <- decrypt cID
           now <- liftIO getCurrentTime
           -- addMessage "debug" [shamlet| #{show res}|]
           success <- runDB $ do
@@ -389,7 +388,7 @@ courseEditHandler isGet course = do
 
 
 data CourseForm = CourseForm
-        { cfCourseId   :: Maybe CryptoUUIDCourse
+        { cfCourseId   :: Maybe CourseId
         , cfName       :: CourseName
         , cfDesc       :: Maybe Html
         , cfLink       :: Maybe Text
@@ -406,9 +405,8 @@ data CourseForm = CourseForm
 
 courseToForm :: MonadCrypto m => Entity Course -> m CourseForm
 courseToForm (Entity cid Course{..}) = do
-  cfCourseId <- Just <$> encrypt cid
   return $ CourseForm
-    { cfCourseId
+    { cfCourseId   = Just cid
     , cfName       = courseName
     , cfDesc       = courseDescription
     , cfLink       = courseLinkExternal
@@ -425,14 +423,15 @@ courseToForm (Entity cid Course{..}) = do
 
 newCourseForm :: Maybe CourseForm -> Form CourseForm
 newCourseForm template = identForm FIDcourse $ \html -> do
-    -- mopt hiddenField
-    --     cidKey <- getsYesod appCryptoIDKey
-    --     courseId <- runMaybeT $ do
-    --         cid <- cfCourseId template
-    --         UUID.encrypt cidKey cid
+    userSchools <- liftHandlerT . runDB $ do
+      userId <- liftHandlerT requireAuthId
+      (fmap concat . sequence)
+        [ map (userLecturerSchool . entityVal) <$> selectList [UserLecturerUser ==. userId] []
+        , map (userAdminSchool . entityVal) <$> selectList [UserAdminUser ==. userId] []
+        ]
+    let schoolField = selectField $ fmap entityKey <$> optionsPersistCryptoId [SchoolId <-. userSchools] [Asc SchoolName] schoolName
     (result, widget) <- flip (renderAForm FormStandard) html $ CourseForm
-      -- <$> pure cid -- $ join $ cfCourseId <$> template -- why doesnt this work?
-      <$> aopt hiddenField "courseId"             (cfCourseId <$> template)
+      <$> pure (cfCourseId =<< template)
       <*> areq (ciField textField) (fslI MsgCourseName)           (cfName     <$> template)
       <*> aopt htmlField (fslI MsgCourseDescription
                          & setTooltip MsgCourseDescriptionTip)   (cfDesc     <$> template)
@@ -476,9 +475,6 @@ newCourseForm template = identForm FIDcourse $ \html -> do
                 |]
               )
       _ -> (result, widget)
---  where
---     cid :: Maybe CourseId
---     cid = join $ cfCourseId <$> template
 
 
 validateCourse :: CourseForm -> [Text]
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 7600f1d8e..f405a6dd7 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -220,16 +220,6 @@ pointsField = checkBool (>= 0) MsgPointsNotPositive Field{..}
 
 --termField: see Utils.Term
 
-schoolField :: Field Handler SchoolId
-schoolField = selectField schools
-  where
-    schools = optionsPersistKey [] [Asc SchoolName] schoolName
-
-schoolEntField :: Field Handler (Entity School)
-schoolEntField = selectField schools
-  where
-    schools = optionsPersist [] [Asc SchoolName] schoolName
-
 zipFileField :: Bool -- ^ Unpack zips?
              -> Field Handler (Source Handler File)
 zipFileField doUnpack = Field{..}
@@ -376,14 +366,14 @@ optionsPersistCryptoId :: forall site backend a msg.
                        => [Filter a]
                        -> [SelectOpt a]
                        -> (a -> msg)
-                       -> HandlerT site IO (OptionList (Key a))
+                       -> HandlerT site IO (OptionList (Entity a))
 optionsPersistCryptoId filts ords toDisplay = fmap mkOptionList $ do
   mr <- getMessageRender
   pairs <- runDB $ selectList filts ords
   cPairs <- forM pairs $ \e@(Entity key _) -> (,) <$> encrypt key <*> pure e
-  return $ map (\(cId, Entity key value) -> Option
+  return $ map (\(cId, e@(Entity key value)) -> Option
                  { optionDisplay = mr (toDisplay value)
-                 , optionInternalValue = key
+                 , optionInternalValue = e
                  , optionExternalValue = toPathPiece (cId :: CryptoID UUID (Key a))
                  }) cPairs