1 {-# LANGUAGE RecordWildCards, TemplateHaskell, QuasiQuotes, DataKinds #-} 2 module Databrary.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 Databrary.Has 19 import Databrary.Service.DB 20 import Databrary.Service.Log 21 import Databrary.Context 22 import Databrary.Model.Time 23 import Databrary.Model.Permission 24 import Databrary.Model.Identity 25 import Databrary.Model.Id 26 import Databrary.Model.Volume 27 import Databrary.Model.VolumeAccess 28 import Databrary.Model.Citation 29 import Databrary.Model.Container 30 import Databrary.Model.Slot 31 import Databrary.Model.Funding 32 import Databrary.Model.Tag 33 import Databrary.Action.Route 34 import Databrary.Controller.Volume 35 import Databrary.EZID.API 36 import Databrary.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