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