    {-# LANGUAGE UndecidableInstances #-}
    module Hackage.Security.TUF.Timestamp (
        Timestamp(..)
      ) where

    import Prelude
    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
    import Hackage.Security.Util.Pretty (pretty)

    {-------------------------------------------------------------------------------
      Datatypes
    -------------------------------------------------------------------------------}

    data Timestamp = Timestamp {
        Timestamp -> FileVersion
    timestampVersion      :: FileVersion
      , Timestamp -> FileExpires
    timestampExpires      :: FileExpires
      , Timestamp -> FileInfo
    timestampInfoSnapshot :: FileInfo
      }

    instance HasHeader Timestamp where
      fileVersion :: Lens' Timestamp FileVersion
    fileVersion FileVersion -> f FileVersion
    f Timestamp
    x = (\FileVersion
    y -> Timestamp
    x { timestampVersion = y }) (FileVersion -> Timestamp) -> f FileVersion -> f Timestamp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FileVersion -> f FileVersion
    f (Timestamp -> FileVersion
    timestampVersion Timestamp
    x)
      fileExpires :: Lens' Timestamp FileExpires
    fileExpires FileExpires -> f FileExpires
    f Timestamp
    x = (\FileExpires
    y -> Timestamp
    x { timestampExpires = y }) (FileExpires -> Timestamp) -> f FileExpires -> f Timestamp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FileExpires -> f FileExpires
    f (Timestamp -> FileExpires
    timestampExpires Timestamp
    x)

    {-------------------------------------------------------------------------------
      JSON
    -------------------------------------------------------------------------------}

    instance MonadReader RepoLayout m => ToJSON m Timestamp where
      toJSON :: Timestamp -> m JSValue
    toJSON Timestamp{FileExpires
    FileVersion
    FileInfo
    timestampVersion :: Timestamp -> FileVersion
    timestampExpires :: Timestamp -> FileExpires
    timestampInfoSnapshot :: Timestamp -> FileInfo
    timestampVersion :: FileVersion
    timestampExpires :: FileExpires
    timestampInfoSnapshot :: FileInfo
    ..} = do
          repoLayout <- m RepoLayout
    forall r (m :: * -> *). MonadReader r m => m r
    ask
          mkObject [
              ("_type"   , return $ JSString "Timestamp")
            , ("version" , toJSON timestampVersion)
            , ("expires" , toJSON timestampExpires)
            , ("meta"    , toJSON (timestampMeta repoLayout))
            ]
        where
          timestampMeta :: RepoLayout -> FileMap
    timestampMeta RepoLayout
    repoLayout = [(TargetPath, FileInfo)] -> FileMap
    FileMap.fromList [
              (RepoLayout -> TargetPath
    pathSnapshot RepoLayout
    repoLayout, FileInfo
    timestampInfoSnapshot)
            ]

    instance ( MonadReader RepoLayout m
             , MonadError DeserializationError m
             , ReportSchemaErrors m
             ) => FromJSON m Timestamp where
      fromJSON :: JSValue -> m Timestamp
    fromJSON JSValue
    enc = do
        JSValue -> String -> m ()
    forall (m :: * -> *).
    (ReportSchemaErrors m, MonadError DeserializationError m) =>
    JSValue -> String -> m ()
    verifyType JSValue
    enc String
    "Timestamp"
        repoLayout            <- m RepoLayout
    forall r (m :: * -> *). MonadReader r m => m r
    ask
        timestampVersion      <- fromJSField enc "version"
        timestampExpires      <- fromJSField enc "expires"
        timestampMeta         <- fromJSField enc "meta"
        let lookupMeta TargetPath
    k = case TargetPath -> FileMap -> Maybe FileInfo
    FileMap.lookup TargetPath
    k FileMap
    timestampMeta of
              Maybe FileInfo
    Nothing -> String -> Maybe String -> m FileInfo
    forall a. String -> Maybe String -> m a
    forall (m :: * -> *) a.
    ReportSchemaErrors m =>
    String -> Maybe String -> m a
    expected (String
    "\"" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ TargetPath -> String
    forall a. Pretty a => a -> String
    pretty TargetPath
    k String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\" entry in .meta object") Maybe String
    forall a. Maybe a
    Nothing
              Just FileInfo
    v  -> FileInfo -> m FileInfo
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure FileInfo
    v
        timestampInfoSnapshot <- lookupMeta (pathSnapshot repoLayout)
        return Timestamp{..}

    instance (MonadKeys m, MonadReader RepoLayout m) => FromJSON m (Signed Timestamp) where
      fromJSON :: JSValue -> m (Signed Timestamp)
    fromJSON = JSValue -> m (Signed Timestamp)
    forall (m :: * -> *) a.
    (MonadKeys m, FromJSON m a) =>
    JSValue -> m (Signed a)
    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 :: RepoLayout -> TargetPath
    pathSnapshot = RepoPath -> TargetPath
    TargetPathRepo (RepoPath -> TargetPath)
    -> (RepoLayout -> RepoPath) -> RepoLayout -> TargetPath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RepoLayout -> RepoPath
    repoLayoutSnapshot