1 {-# LANGUAGE RecordWildCards, TemplateHaskell, QuasiQuotes, DataKinds #-} 2 module EZID.Volume 3 ( updateEZID 4 ) where 5 6 import Control.Arrow ((&&&)) 7 import Control.Monad ((<=<)) 8 import Control.Monad.IO.Class (liftIO) 9 import qualified Data.ByteString as BS 10 import qualified Data.ByteString.Char8 as BSC 11 import Data.Function (on) 12 import Data.List (deleteFirstsBy) 13 import Data.Maybe (fromMaybe, mapMaybe) 14 import Data.Time.Clock (utctDay, getCurrentTime) 15 import Database.PostgreSQL.Typed.Query (pgSQL) 16 import qualified Network.Wai as Wai 17 18 import Has 19 import Service.DB 20 import Service.Log 21 import Context 22 import Model.Time 23 import Model.Permission 24 import Model.Identity 25 import Model.Id 26 import Model.Volume 27 import Model.VolumeAccess 28 import Model.Citation 29 import Model.Container 30 import Model.Slot 31 import Model.Funding 32 import Model.Tag 33 import Action.Route 34 import Controller.Volume 35 import EZID.API 36 import EZID.DataCite 37 38 useTDB 39 40 volumeDOISuffix :: Id Volume -> BS.ByteString 41 volumeDOISuffix i = BSC.pack $ '.' : show i 42 43 volumeEZID :: (MonadDB c m, MonadHasIdentity c m) => Volume -> Maybe Citation -> m EZIDMeta 44 volumeEZID v@Volume{ volumeRow = VolumeRow{..}, ..} cite = do 45 top <- lookupVolumeTopContainer v 46 own <- lookupVolumeAccess v PermissionADMIN 47 fund <- lookupVolumeFunding v 48 link <- lookupVolumeLinks v 49 key <- lookupSlotKeywords (containerSlot top) 50 return EZIDPublic 51 { ezidTarget = actionURI (Just Wai.defaultRequest) viewVolume (HTML, volumeId) [] 52 , ezidDataCite = DataCite 53 { dataCiteDOI = volumeDOI 54 , dataCiteTitle = volumeName 55 , dataCiteAuthors = map volumeAccessParty own 56 , dataCiteYear = dateYear (utctDay volumeCreation) 57 , dataCiteDescription = volumeBody 58 , dataCiteFunders = fund 59 , dataCitePublication = citationURL =<< cite 60 , dataCiteReferences = mapMaybe citationURL link 61 , dataCiteSubjects = map (tagNameBS . tagName) key 62 } 63 } 64 65 lookupVolumeDOIs :: MonadDB c m => m [(Id Volume, BS.ByteString)] 66 lookupVolumeDOIs = dbQuery [pgSQL|!SELECT id, doi FROM volume WHERE doi IS NOT NULL|] 67 68 addVolumeDOI :: MonadDB c m => Id Volume -> BS.ByteString -> m Bool 69 addVolumeDOI v d = dbExecute1 [pgSQL|UPDATE volume SET doi = ${d} WHERE id = ${v} AND doi IS NULL|] 70 71 updateVolume :: Volume -> Maybe Citation -> EZIDM Bool 72 updateVolume v = maybe 73 (maybe (return False) (addVolumeDOI $ volumeId $ volumeRow v) <=< ezidCreate (volumeDOISuffix $ volumeId $ volumeRow v)) 74 ezidModify 75 (volumeDOI $ volumeRow v) 76 <=< volumeEZID v 77 78 removeVolume :: Id Volume -> BS.ByteString -> EZIDM Bool 79 removeVolume _ d = ezidModify d EZIDUnavailable 80 81 updateEZID :: BackgroundContextM (Maybe Bool) 82 updateEZID = runEZIDM $ do 83 r <- ezidStatus 84 if r 85 then do 86 vl <- lookupVolumesCitations 87 mapM_ (uncurry updateVolume) vl 88 dl <- lookupVolumeDOIs 89 mapM_ (uncurry removeVolume) $ 90 deleteFirstsBy (on (==) fst) dl (map ((volumeId &&& fromMaybe BS.empty . volumeDOI) . volumeRow . fst) vl) 91 else do 92 t <- liftIO getCurrentTime 93 focusIO $ logMsg t "ezid is down" 94 return r