    -- | Header used by all TUF types
    module Hackage.Security.TUF.Header (
        HasHeader(..)
      , FileVersion(..)
      , FileExpires(..)
      , Header(..)
        -- ** Utility
      , expiresInDays
      , expiresNever
      , isExpired
      , versionInitial
      , versionIncrement
      ) where

    import Prelude
    import Data.Time

    import Hackage.Security.JSON
    import Hackage.Security.Util.Lens

    {-------------------------------------------------------------------------------
      TUF header
    -------------------------------------------------------------------------------}

    class HasHeader a where
      -- | File expiry date
      fileExpires :: Lens' a FileExpires

      -- | File version (monotonically increasing counter)
      fileVersion :: Lens' a FileVersion

    -- | File version
    --
    -- The file version is a flat integer which must monotonically increase on
    -- every file update.
    --
    -- 'Show' and 'Read' instance are defined in terms of the underlying 'Int'
    -- (this is used for example by Hackage during the backup process).
    newtype FileVersion = FileVersion Int54
      deriving (FileVersion -> FileVersion -> Bool
    (FileVersion -> FileVersion -> Bool)
    -> (FileVersion -> FileVersion -> Bool) -> Eq FileVersion
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FileVersion -> FileVersion -> Bool
    == :: FileVersion -> FileVersion -> Bool
    $c/= :: FileVersion -> FileVersion -> Bool
    /= :: FileVersion -> FileVersion -> Bool
    Eq, Eq FileVersion
    Eq FileVersion =>
    (FileVersion -> FileVersion -> Ordering)
    -> (FileVersion -> FileVersion -> Bool)
    -> (FileVersion -> FileVersion -> Bool)
    -> (FileVersion -> FileVersion -> Bool)
    -> (FileVersion -> FileVersion -> Bool)
    -> (FileVersion -> FileVersion -> FileVersion)
    -> (FileVersion -> FileVersion -> FileVersion)
    -> Ord FileVersion
    FileVersion -> FileVersion -> Bool
    FileVersion -> FileVersion -> Ordering
    FileVersion -> FileVersion -> FileVersion
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: FileVersion -> FileVersion -> Ordering
    compare :: FileVersion -> FileVersion -> Ordering
    $c< :: FileVersion -> FileVersion -> Bool
    < :: FileVersion -> FileVersion -> Bool
    $c<= :: FileVersion -> FileVersion -> Bool
    <= :: FileVersion -> FileVersion -> Bool
    $c> :: FileVersion -> FileVersion -> Bool
    > :: FileVersion -> FileVersion -> Bool
    $c>= :: FileVersion -> FileVersion -> Bool
    >= :: FileVersion -> FileVersion -> Bool
    $cmax :: FileVersion -> FileVersion -> FileVersion
    max :: FileVersion -> FileVersion -> FileVersion
    $cmin :: FileVersion -> FileVersion -> FileVersion
    min :: FileVersion -> FileVersion -> FileVersion
    Ord)

    instance Show FileVersion where
      show :: FileVersion -> String
    show (FileVersion Int54
    v) = Int54 -> String
    forall a. Show a => a -> String
    show Int54
    v

    instance Read FileVersion where
      readsPrec :: Int -> ReadS FileVersion
    readsPrec Int
    p = ((Int54, String) -> (FileVersion, String))
    -> [(Int54, String)] -> [(FileVersion, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Int54
    v, String
    xs) -> (Int54 -> FileVersion
    FileVersion Int54
    v, String
    xs)) ([(Int54, String)] -> [(FileVersion, String)])
    -> (String -> [(Int54, String)]) -> ReadS FileVersion
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> [(Int54, String)]
    forall a. Read a => Int -> ReadS a
    readsPrec Int
    p

    -- | File expiry date
    --
    -- A 'Nothing' value here means no expiry. That makes it possible to set some
    -- files to never expire. (Note that not having the Maybe in the type here still
    -- allows that, because you could set an expiry date 2000 years into the future.
    -- By having the Maybe here we avoid the _need_ for such encoding issues.)
    newtype FileExpires = FileExpires (Maybe UTCTime)
      deriving (FileExpires -> FileExpires -> Bool
    (FileExpires -> FileExpires -> Bool)
    -> (FileExpires -> FileExpires -> Bool) -> Eq FileExpires
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FileExpires -> FileExpires -> Bool
    == :: FileExpires -> FileExpires -> Bool
    $c/= :: FileExpires -> FileExpires -> Bool
    /= :: FileExpires -> FileExpires -> Bool
    Eq, Eq FileExpires
    Eq FileExpires =>
    (FileExpires -> FileExpires -> Ordering)
    -> (FileExpires -> FileExpires -> Bool)
    -> (FileExpires -> FileExpires -> Bool)
    -> (FileExpires -> FileExpires -> Bool)
    -> (FileExpires -> FileExpires -> Bool)
    -> (FileExpires -> FileExpires -> FileExpires)
    -> (FileExpires -> FileExpires -> FileExpires)
    -> Ord FileExpires
    FileExpires -> FileExpires -> Bool
    FileExpires -> FileExpires -> Ordering
    FileExpires -> FileExpires -> FileExpires
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: FileExpires -> FileExpires -> Ordering
    compare :: FileExpires -> FileExpires -> Ordering
    $c< :: FileExpires -> FileExpires -> Bool
    < :: FileExpires -> FileExpires -> Bool
    $c<= :: FileExpires -> FileExpires -> Bool
    <= :: FileExpires -> FileExpires -> Bool
    $c> :: FileExpires -> FileExpires -> Bool
    > :: FileExpires -> FileExpires -> Bool
    $c>= :: FileExpires -> FileExpires -> Bool
    >= :: FileExpires -> FileExpires -> Bool
    $cmax :: FileExpires -> FileExpires -> FileExpires
    max :: FileExpires -> FileExpires -> FileExpires
    $cmin :: FileExpires -> FileExpires -> FileExpires
    min :: FileExpires -> FileExpires -> FileExpires
    Ord, Int -> FileExpires -> ShowS
    [FileExpires] -> ShowS
    FileExpires -> String
    (Int -> FileExpires -> ShowS)
    -> (FileExpires -> String)
    -> ([FileExpires] -> ShowS)
    -> Show FileExpires
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> FileExpires -> ShowS
    showsPrec :: Int -> FileExpires -> ShowS
    $cshow :: FileExpires -> String
    show :: FileExpires -> String
    $cshowList :: [FileExpires] -> ShowS
    showList :: [FileExpires] -> ShowS
    Show)

    -- | Occasionally it is useful to read only a header from a file.
    --
    -- 'HeaderOnly' intentionally only has a 'FromJSON' instance (no 'ToJSON').
    data Header = Header {
        Header -> FileExpires
    headerExpires :: FileExpires
      , Header -> FileVersion
    headerVersion :: FileVersion
      }

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

    {-------------------------------------------------------------------------------
      Utility
    -------------------------------------------------------------------------------}

    expiresNever :: FileExpires
    expiresNever :: FileExpires
    expiresNever = Maybe UTCTime -> FileExpires
    FileExpires Maybe UTCTime
    forall a. Maybe a
    Nothing

    expiresInDays :: UTCTime -> Integer -> FileExpires
    expiresInDays :: UTCTime -> Integer -> FileExpires
    expiresInDays UTCTime
    now Integer
    n =
        Maybe UTCTime -> FileExpires
    FileExpires (Maybe UTCTime -> FileExpires)
    -> (UTCTime -> Maybe UTCTime) -> UTCTime -> FileExpires
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UTCTime -> Maybe UTCTime
    forall a. a -> Maybe a
    Just (UTCTime -> FileExpires) -> UTCTime -> FileExpires
    forall a b. (a -> b) -> a -> b
    $ NominalDiffTime -> UTCTime -> UTCTime
    addUTCTime (Integer -> NominalDiffTime
    forall a. Num a => Integer -> a
    fromInteger Integer
    n NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    * NominalDiffTime
    oneDay) UTCTime
    now

    isExpired :: UTCTime -> FileExpires -> Bool
    isExpired :: UTCTime -> FileExpires -> Bool
    isExpired UTCTime
    _   (FileExpires Maybe UTCTime
    Nothing)  = Bool
    False
    isExpired UTCTime
    now (FileExpires (Just UTCTime
    e)) = UTCTime
    e UTCTime -> UTCTime -> Bool
    forall a. Ord a => a -> a -> Bool
    < UTCTime
    now

    versionInitial :: FileVersion
    versionInitial :: FileVersion
    versionInitial = Int54 -> FileVersion
    FileVersion Int54
    1

    versionIncrement :: FileVersion -> FileVersion
    versionIncrement :: FileVersion -> FileVersion
    versionIncrement (FileVersion Int54
    i) = Int54 -> FileVersion
    FileVersion (Int54
    i Int54 -> Int54 -> Int54
    forall a. Num a => a -> a -> a
    + Int54
    1)

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

    instance Monad m => ToJSON m FileVersion where
      toJSON :: FileVersion -> m JSValue
    toJSON (FileVersion Int54
    i) = Int54 -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON Int54
    i

    instance Monad m => ToJSON m FileExpires where
      toJSON :: FileExpires -> m JSValue
    toJSON (FileExpires (Just UTCTime
    e)) = UTCTime -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON UTCTime
    e
      toJSON (FileExpires Maybe UTCTime
    Nothing)  = JSValue -> m JSValue
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return JSValue
    JSNull

    instance ReportSchemaErrors m => FromJSON m FileVersion where
      fromJSON :: JSValue -> m FileVersion
    fromJSON JSValue
    enc = Int54 -> FileVersion
    FileVersion (Int54 -> FileVersion) -> m Int54 -> m FileVersion
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> JSValue -> m Int54
    forall (m :: * -> *) a. FromJSON m a => JSValue -> m a
    fromJSON JSValue
    enc

    instance ReportSchemaErrors m => FromJSON m FileExpires where
      fromJSON :: JSValue -> m FileExpires
    fromJSON JSValue
    JSNull = FileExpires -> m FileExpires
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FileExpires -> m FileExpires) -> FileExpires -> m FileExpires
    forall a b. (a -> b) -> a -> b
    $ Maybe UTCTime -> FileExpires
    FileExpires Maybe UTCTime
    forall a. Maybe a
    Nothing
      fromJSON JSValue
    enc    = Maybe UTCTime -> FileExpires
    FileExpires (Maybe UTCTime -> FileExpires)
    -> (UTCTime -> Maybe UTCTime) -> UTCTime -> FileExpires
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UTCTime -> Maybe UTCTime
    forall a. a -> Maybe a
    Just (UTCTime -> FileExpires) -> m UTCTime -> m FileExpires
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> JSValue -> m UTCTime
    forall (m :: * -> *) a. FromJSON m a => JSValue -> m a
    fromJSON JSValue
    enc

    instance ReportSchemaErrors m => FromJSON m Header where
      fromJSON :: JSValue -> m Header
    fromJSON JSValue
    enc = do
        headerExpires <- JSValue -> String -> m FileExpires
    forall (m :: * -> *) a.
    (ReportSchemaErrors m, FromJSON m a) =>
    JSValue -> String -> m a
    fromJSField JSValue
    enc String
    "expires"
        headerVersion <- fromJSField enc "version"
        return Header{..}

    {-------------------------------------------------------------------------------
      Auxiliary
    -------------------------------------------------------------------------------}

    oneDay :: NominalDiffTime
    oneDay :: NominalDiffTime
    oneDay = NominalDiffTime
    24 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    * NominalDiffTime
    60 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    * NominalDiffTime
    60