{-# LANGUAGE UndecidableInstances #-} module Hackage.Security.TUF.Timestamp ( Timestamp(..) ) where import Control.Monad.Except import Control.Monad.Reader import Hackage.Security.JSON import Hackage.Security.TUF.FileInfo import Hackage.Security.TUF.FileMap import Hackage.Security.TUF.Header import Hackage.Security.TUF.Layout.Repo import Hackage.Security.TUF.Signed import qualified Hackage.Security.TUF.FileMap as FileMap {------------------------------------------------------------------------------- Datatypes -------------------------------------------------------------------------------} data Timestamp = Timestamp { timestampVersion :: FileVersion , timestampExpires :: FileExpires , timestampInfoSnapshot :: FileInfo } instance HasHeader Timestamp where fileVersion f x = (\y -> x { timestampVersion = y }) <$> f (timestampVersion x) fileExpires f x = (\y -> x { timestampExpires = y }) <$> f (timestampExpires x) {------------------------------------------------------------------------------- JSON -------------------------------------------------------------------------------} instance MonadReader RepoLayout m => ToJSON m Timestamp where toJSON Timestamp{..} = do repoLayout <- ask mkObject [ ("_type" , return $ JSString "Timestamp") , ("version" , toJSON timestampVersion) , ("expires" , toJSON timestampExpires) , ("meta" , toJSON (timestampMeta repoLayout)) ] where timestampMeta repoLayout = FileMap.fromList [ (pathSnapshot repoLayout, timestampInfoSnapshot) ] instance ( MonadReader RepoLayout m , MonadError DeserializationError m , ReportSchemaErrors m ) => FromJSON m Timestamp where fromJSON enc = do verifyType enc "Timestamp" repoLayout <- ask timestampVersion <- fromJSField enc "version" timestampExpires <- fromJSField enc "expires" timestampMeta <- fromJSField enc "meta" timestampInfoSnapshot <- FileMap.lookupM timestampMeta (pathSnapshot repoLayout) return Timestamp{..} instance (MonadKeys m, MonadReader RepoLayout m) => FromJSON m (Signed Timestamp) where fromJSON = signedFromJSON {------------------------------------------------------------------------------- Paths used in the timestamp NOTE: Since the timestamp lives in the top-level directory of the repository, we can safely reinterpret "relative to the repo root" as "relative to the timestamp"; hence, this use of 'castRoot' is okay. -------------------------------------------------------------------------------} pathSnapshot :: RepoLayout -> TargetPath pathSnapshot = TargetPathRepo . repoLayoutSnapshot