diff --git a/Handler/AdminMediumSettings.hs b/Handler/AdminMediumSettings.hs index 4c44c12..1291d93 100755 --- a/Handler/AdminMediumSettings.hs +++ b/Handler/AdminMediumSettings.hs @@ -97,7 +97,10 @@ adminMediumSetForm medium = Medium <*> areq tagField (bfs ("Tags" :: T.Text)) (Just $ mediumTags medium) <*> pure (mediumAlbum medium) <*> pure (mediumPreview medium) + <*> areq (selectField licenses) (bfs ("Licence" :: T.Text)) (Just $ mediumLicence medium) <* bootstrapSubmit ("Change settings" :: BootstrapSubmit Text) + where + licenses = optionsPairs $ map (\a -> (T.pack (show (toEnum a :: Licence)), a)) [-2..6] getAdminMediumDeleteR :: MediumId -> Handler Html getAdminMediumDeleteR mediumId = do diff --git a/Handler/AdminProfileSettings.hs b/Handler/AdminProfileSettings.hs index 66be74b..35fc520 100755 --- a/Handler/AdminProfileSettings.hs +++ b/Handler/AdminProfileSettings.hs @@ -139,6 +139,7 @@ adminProfileForm owner = User <*> pure (userSalted owner) <*> pure (userAlbums owner) <*> areq boolField (bfs ("Admin" :: T.Text)) (Just $ userAdmin owner) + <*> areq (selectField optionsEnum) (bfs ("Default licence" :: T.Text) (Just $ userDefaultLicense owner) <* bootstrapSubmit ("Change settings" :: BootstrapSubmit T.Text) getAdminProfileDeleteR :: UserId -> Handler Html diff --git a/Handler/ProfileSettings.hs b/Handler/ProfileSettings.hs index 4f7e31f..cec9500 100755 --- a/Handler/ProfileSettings.hs +++ b/Handler/ProfileSettings.hs @@ -67,4 +67,8 @@ profileSettingsForm user = User <*> pure (userSalted user) <*> pure (userAlbums user) <*> pure (userAdmin user) + <*> areq (selectField licences) (bfs ("Default licence for media" :: T.Text)) + (Just $ userDefaultLicence user) <* bootstrapSubmit ("Change settings" :: BootstrapSubmit Text) + where + licenses = optionsPairs $ map (\a -> (T.pack (show (toEnum a :: Licence)), a)) [-2..6] diff --git a/Handler/Signup.hs b/Handler/Signup.hs index dcb2648..436fd37 100755 --- a/Handler/Signup.hs +++ b/Handler/Signup.hs @@ -61,7 +61,7 @@ postSignupR = do case namesakes of [] -> do salt <- liftIO generateSalt - let newUser = User newUserName newUserName (fromJust mEmail) salt "" [] False + let newUser = User newUserName newUserName (fromJust mEmail) salt "" [] False (fromEnum AllRightsReserved) activatorText <- liftIO generateString _ <- runDB $ insert $ Activator activatorText newUser _ <- runDB $ insert $ Token (encodeUtf8 activatorText) "activate" Nothing diff --git a/Model.hs b/Model.hs index aaab070..ed505a2 100755 --- a/Model.hs +++ b/Model.hs @@ -27,3 +27,48 @@ import qualified System.FilePath as FP -- http://www.yesodweb.com/book/persistent/ share [mkPersist sqlSettings, mkMigrate "migrateAll"] $(persistFileWith lowerCaseSettings "config/models") + +data Licence + = AllRightsReserved + | CC0 + | CCBy4 + | CCBySa4 + | CCByNd4 + | CCByNc4 + | CCByNcSa4 + | CCByNcNd4 + | PublicDomain + +instance Show Licence where + show AllRightsReserved = "All rights reserved" + show CC0 = "CC0 1.0" + show CCBy4 = "CC-BY 4.0 International" + show CCBySa4 = "CC-BY-SA 4.0 International" + show CCByNd4 = "CC-BY-ND 4.0 International" + show CCByNc4 = "CC-BY-NC 4.0 International" + show CCByNcSa4 = "CC-BY-NC-SA 4.0 International" + show CCByNcNd4 = "CC-BY-NC-ND 4.0 International" + show PublicDomain = "Public Domain" + +instance Enum Licence where + fromEnum PublicDomain = -2 + fromEnum AllRightsReserved = -1 + fromEnum CC0 = 0 + fromEnum CCBy4 = 1 + fromEnum CCBySa4 = 2 + fromEnum CCByNd4 = 3 + fromEnum CCByNc4 = 4 + fromEnum CCByNcSa4 = 5 + fromEnum CCByNcNd4 = 6 + fromEnum n = error $ "no licence no. for" ++ show n + + toEnum (-2) = PublicDomain + toEnum (-1) = AllRightsReserved + toEnum 0 = CC0 + toEnum 1 = CCBy4 + toEnum 2 = CCBySa4 + toEnum 3 = CCByNd4 + toEnum 4 = CCByNc4 + toEnum 5 = CCByNcSa4 + toEnum 6 = CCByNcNd4 + toEnum n = error $ "No licence no. " ++ show n diff --git a/config/models b/config/models index efdf8ce..fd89d2d 100755 --- a/config/models +++ b/config/models @@ -22,6 +22,7 @@ User salted ByteString albums [AlbumId] admin Bool + defaultLicence Int default=-1 UniqueUser name deriving Typeable Eq Show Activator @@ -39,7 +40,6 @@ Album shares [UserId] content [MediumId] samplePic FP.FilePath Maybe --- sampleWidth Int deriving Eq Show Medium title Text @@ -50,15 +50,12 @@ Medium owner UserId description Textarea Maybe tags Texts --- width Int --- thumbWidth Int album AlbumId preview FP.FilePath --- previewWidth Int + licence Int default=-1 deriving Eq Show Comment author UserId --- authorSlug Text origin MediumId parent CommentId Maybe time UTCTime