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

import MyPrelude
import Data.Time
import Data.Typeable (Typeable)

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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileVersion -> FileVersion -> Bool
$c/= :: FileVersion -> FileVersion -> Bool
== :: FileVersion -> FileVersion -> Bool
$c== :: FileVersion -> FileVersion -> Bool
Eq, Eq 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
min :: FileVersion -> FileVersion -> FileVersion
$cmin :: FileVersion -> FileVersion -> FileVersion
max :: FileVersion -> FileVersion -> FileVersion
$cmax :: FileVersion -> FileVersion -> FileVersion
>= :: FileVersion -> FileVersion -> Bool
$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
compare :: FileVersion -> FileVersion -> Ordering
$ccompare :: FileVersion -> FileVersion -> Ordering
Ord, Typeable)

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

instance Read FileVersion where
  readsPrec :: Int -> ReadS FileVersion
readsPrec Int
p = forall a b. (a -> b) -> [a] -> [b]
map (\(Int54
v, String
xs) -> (Int54 -> FileVersion
FileVersion Int54
v, String
xs)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileExpires -> FileExpires -> Bool
$c/= :: FileExpires -> FileExpires -> Bool
== :: FileExpires -> FileExpires -> Bool
$c== :: FileExpires -> FileExpires -> Bool
Eq, Eq 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
min :: FileExpires -> FileExpires -> FileExpires
$cmin :: FileExpires -> FileExpires -> FileExpires
max :: FileExpires -> FileExpires -> FileExpires
$cmax :: FileExpires -> FileExpires -> FileExpires
>= :: FileExpires -> FileExpires -> Bool
$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
compare :: FileExpires -> FileExpires -> Ordering
$ccompare :: FileExpires -> FileExpires -> Ordering
Ord, Int -> FileExpires -> ShowS
[FileExpires] -> ShowS
FileExpires -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileExpires] -> ShowS
$cshowList :: [FileExpires] -> ShowS
show :: FileExpires -> String
$cshow :: FileExpires -> String
showsPrec :: Int -> FileExpires -> ShowS
$cshowsPrec :: Int -> FileExpires -> ShowS
Show, Typeable)

-- | 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 :: FileExpires
headerExpires = FileExpires
y }) 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 :: FileVersion
headerVersion = FileVersion
y }) 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 forall a. Maybe a
Nothing

expiresInDays :: UTCTime -> Integer -> FileExpires
expiresInDays :: UTCTime -> Integer -> FileExpires
expiresInDays UTCTime
now Integer
n =
    Maybe UTCTime -> FileExpires
FileExpires forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (forall a. Num a => Integer -> a
fromInteger Integer
n 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 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 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) = 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)) = forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON UTCTime
e
  toJSON (FileExpires Maybe UTCTime
Nothing)  = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe UTCTime -> FileExpires
FileExpires forall a. Maybe a
Nothing
  fromJSON JSValue
enc    = Maybe UTCTime -> FileExpires
FileExpires forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
    FileExpires
headerExpires <- forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc String
"expires"
    FileVersion
headerVersion <- forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc String
"version"
    forall (m :: * -> *) a. Monad m => a -> m a
return Header{FileExpires
FileVersion
headerVersion :: FileVersion
headerExpires :: FileExpires
headerVersion :: FileVersion
headerExpires :: FileExpires
..}

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

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