State.hs

{-# LANGUAGE DeriveDataTypeable, TypeFamilies, TemplateHaskell #-}

module Distribution.Server.Features.Upload.State where

import Distribution.Server.Framework.Instances ()
import Distribution.Server.Framework.MemSize

import Distribution.Package
import qualified Distribution.Server.Users.Group as Group
import Distribution.Server.Users.Group (UserList)
import Distribution.Server.Users.Types (UserId)

import Data.Acid     (Query, Update, makeAcidic)
import Data.SafeCopy (base, deriveSafeCopy)
import Data.Typeable
import Control.Monad.Reader
import qualified Control.Monad.State as State
import Data.Maybe (fromMaybe)

import qualified Data.Map as Map

-------------------------------- Maintainer list
data PackageMaintainers = PackageMaintainers {
    maintainers :: Map.Map PackageName UserList
} deriving (Eq, Show, Typeable)

deriveSafeCopy 0 'base ''PackageMaintainers

instance MemSize PackageMaintainers where
    memSize (PackageMaintainers a) = memSize1 a

initialPackageMaintainers :: PackageMaintainers
initialPackageMaintainers = PackageMaintainers Map.empty

getPackageMaintainers :: PackageName -> Query PackageMaintainers UserList
getPackageMaintainers name = asks $ fromMaybe Group.empty . Map.lookup name . maintainers

modifyPackageMaintainers :: PackageName -> (UserList -> UserList) -> Update PackageMaintainers ()
modifyPackageMaintainers name func = State.modify (\pm -> pm {maintainers = alterFunc (maintainers pm) })
    where alterFunc = Map.alter (Just . func . fromMaybe Group.empty) name

addPackageMaintainer :: PackageName -> UserId -> Update PackageMaintainers ()
addPackageMaintainer name uid = modifyPackageMaintainers name (Group.add uid)

removePackageMaintainer :: PackageName -> UserId -> Update PackageMaintainers ()
removePackageMaintainer name uid = modifyPackageMaintainers name (Group.remove uid)

setPackageMaintainers :: PackageName -> UserList -> Update PackageMaintainers ()
setPackageMaintainers name ulist = modifyPackageMaintainers name (const ulist)

allPackageMaintainers :: Query PackageMaintainers PackageMaintainers
allPackageMaintainers = ask

replacePackageMaintainers :: PackageMaintainers -> Update PackageMaintainers ()
replacePackageMaintainers = State.put

makeAcidic ''PackageMaintainers ['getPackageMaintainers
                                ,'addPackageMaintainer
                                ,'removePackageMaintainer
                                ,'setPackageMaintainers
                                ,'replacePackageMaintainers
                                ,'allPackageMaintainers
                                ]

-------------------------------- Trustee list
-- this could be reasonably merged into the above, as a PackageGroups data structure
data HackageTrustees = HackageTrustees {
    trusteeList :: !UserList
} deriving (Show, Typeable, Eq)

deriveSafeCopy 0 'base ''HackageTrustees

instance MemSize HackageTrustees where
    memSize (HackageTrustees a) = memSize1 a

initialHackageTrustees :: HackageTrustees
initialHackageTrustees = HackageTrustees Group.empty

getHackageTrustees :: Query HackageTrustees HackageTrustees
getHackageTrustees = ask

getTrusteesList :: Query HackageTrustees UserList
getTrusteesList = asks trusteeList

modifyHackageTrustees :: (UserList -> UserList) -> Update HackageTrustees ()
modifyHackageTrustees func = State.modify (\ht -> ht {trusteeList = func (trusteeList ht) })

addHackageTrustee :: UserId -> Update HackageTrustees ()
addHackageTrustee uid = modifyHackageTrustees (Group.add uid)

removeHackageTrustee :: UserId -> Update HackageTrustees ()
removeHackageTrustee uid = modifyHackageTrustees (Group.remove uid)

replaceHackageTrustees :: UserList -> Update HackageTrustees ()
replaceHackageTrustees ulist = modifyHackageTrustees (const ulist)

makeAcidic ''HackageTrustees ['getHackageTrustees
                             ,'getTrusteesList
                             ,'addHackageTrustee
                             ,'removeHackageTrustee
                             ,'replaceHackageTrustees
                             ]

-------------------------------- Uploader list
data HackageUploaders = HackageUploaders {
    uploaderList :: !UserList
} deriving (Show, Typeable, Eq)

$(deriveSafeCopy 0 'base ''HackageUploaders)

instance MemSize HackageUploaders where
    memSize (HackageUploaders a) = memSize1 a

initialHackageUploaders :: HackageUploaders
initialHackageUploaders = HackageUploaders Group.empty

getHackageUploaders :: Query HackageUploaders HackageUploaders
getHackageUploaders = ask

getUploadersList :: Query HackageUploaders UserList
getUploadersList = asks uploaderList

modifyHackageUploaders :: (UserList -> UserList) -> Update HackageUploaders ()
modifyHackageUploaders func = State.modify (\ht -> ht {uploaderList = func (uploaderList ht) })

addHackageUploader :: UserId -> Update HackageUploaders ()
addHackageUploader uid = modifyHackageUploaders (Group.add uid)

removeHackageUploader :: UserId -> Update HackageUploaders ()
removeHackageUploader uid = modifyHackageUploaders (Group.remove uid)

replaceHackageUploaders :: UserList -> Update HackageUploaders ()
replaceHackageUploaders ulist = modifyHackageUploaders (const ulist)

makeAcidic ''HackageUploaders ['getHackageUploaders
                              ,'getUploadersList
                              ,'addHackageUploader
                              ,'removeHackageUploader
                              ,'replaceHackageUploaders
                              ]