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