module Hackage.Security.TUF.Root (
Root(..)
, RootRoles(..)
, RoleSpec(..)
) where
import Hackage.Security.JSON
import Hackage.Security.Key
import Hackage.Security.Key.Env (KeyEnv)
import Hackage.Security.TUF.Common
import Hackage.Security.TUF.Header
import Hackage.Security.TUF.Mirrors
import Hackage.Security.TUF.Signed
import Hackage.Security.TUF.Snapshot
import Hackage.Security.TUF.Targets
import Hackage.Security.TUF.Timestamp
import Hackage.Security.Util.Some
data Root = Root {
Root -> FileVersion
rootVersion :: FileVersion
, Root -> FileExpires
rootExpires :: FileExpires
, Root -> KeyEnv
rootKeys :: KeyEnv
, Root -> RootRoles
rootRoles :: RootRoles
}
data RootRoles = RootRoles {
RootRoles -> RoleSpec Root
rootRolesRoot :: RoleSpec Root
, RootRoles -> RoleSpec Snapshot
rootRolesSnapshot :: RoleSpec Snapshot
, RootRoles -> RoleSpec Targets
rootRolesTargets :: RoleSpec Targets
, RootRoles -> RoleSpec Timestamp
rootRolesTimestamp :: RoleSpec Timestamp
, RootRoles -> RoleSpec Mirrors
rootRolesMirrors :: RoleSpec Mirrors
}
data RoleSpec a = RoleSpec {
RoleSpec a -> [Some PublicKey]
roleSpecKeys :: [Some PublicKey]
, RoleSpec a -> KeyThreshold
roleSpecThreshold :: KeyThreshold
}
deriving (Int -> RoleSpec a -> ShowS
[RoleSpec a] -> ShowS
RoleSpec a -> String
(Int -> RoleSpec a -> ShowS)
-> (RoleSpec a -> String)
-> ([RoleSpec a] -> ShowS)
-> Show (RoleSpec a)
forall a. Int -> RoleSpec a -> ShowS
forall a. [RoleSpec a] -> ShowS
forall a. RoleSpec a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RoleSpec a] -> ShowS
$cshowList :: forall a. [RoleSpec a] -> ShowS
show :: RoleSpec a -> String
$cshow :: forall a. RoleSpec a -> String
showsPrec :: Int -> RoleSpec a -> ShowS
$cshowsPrec :: forall a. Int -> RoleSpec a -> ShowS
Show)
instance HasHeader Root where
fileVersion :: LensLike f Root Root FileVersion FileVersion
fileVersion f :: FileVersion -> f FileVersion
f x :: Root
x = (\y :: FileVersion
y -> Root
x { rootVersion :: FileVersion
rootVersion = FileVersion
y }) (FileVersion -> Root) -> f FileVersion -> f Root
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileVersion -> f FileVersion
f (Root -> FileVersion
rootVersion Root
x)
fileExpires :: LensLike f Root Root FileExpires FileExpires
fileExpires f :: FileExpires -> f FileExpires
f x :: Root
x = (\y :: FileExpires
y -> Root
x { rootExpires :: FileExpires
rootExpires = FileExpires
y }) (FileExpires -> Root) -> f FileExpires -> f Root
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileExpires -> f FileExpires
f (Root -> FileExpires
rootExpires Root
x)
instance Monad m => ToJSON m RootRoles where
toJSON :: RootRoles -> m JSValue
toJSON RootRoles{..} = [(String, m JSValue)] -> m JSValue
forall (m :: * -> *). Monad m => [(String, m JSValue)] -> m JSValue
mkObject [
("root" , RoleSpec Root -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON RoleSpec Root
rootRolesRoot)
, ("snapshot" , RoleSpec Snapshot -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON RoleSpec Snapshot
rootRolesSnapshot)
, ("targets" , RoleSpec Targets -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON RoleSpec Targets
rootRolesTargets)
, ("timestamp" , RoleSpec Timestamp -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON RoleSpec Timestamp
rootRolesTimestamp)
, ("mirrors" , RoleSpec Mirrors -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON RoleSpec Mirrors
rootRolesMirrors)
]
instance MonadKeys m => FromJSON m RootRoles where
fromJSON :: JSValue -> m RootRoles
fromJSON enc :: JSValue
enc = do
RoleSpec Root
rootRolesRoot <- JSValue -> String -> m (RoleSpec Root)
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc "root"
RoleSpec Snapshot
rootRolesSnapshot <- JSValue -> String -> m (RoleSpec Snapshot)
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc "snapshot"
RoleSpec Targets
rootRolesTargets <- JSValue -> String -> m (RoleSpec Targets)
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc "targets"
RoleSpec Timestamp
rootRolesTimestamp <- JSValue -> String -> m (RoleSpec Timestamp)
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc "timestamp"
RoleSpec Mirrors
rootRolesMirrors <- JSValue -> String -> m (RoleSpec Mirrors)
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc "mirrors"
RootRoles -> m RootRoles
forall (m :: * -> *) a. Monad m => a -> m a
return RootRoles :: RoleSpec Root
-> RoleSpec Snapshot
-> RoleSpec Targets
-> RoleSpec Timestamp
-> RoleSpec Mirrors
-> RootRoles
RootRoles{..}
instance Monad m => ToJSON m Root where
toJSON :: Root -> m JSValue
toJSON Root{..} = [(String, m JSValue)] -> m JSValue
forall (m :: * -> *). Monad m => [(String, m JSValue)] -> m JSValue
mkObject [
("_type" , JSValue -> m JSValue
forall (m :: * -> *) a. Monad m => a -> m a
return (JSValue -> m JSValue) -> JSValue -> m JSValue
forall a b. (a -> b) -> a -> b
$ String -> JSValue
JSString "Root")
, ("version" , FileVersion -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON FileVersion
rootVersion)
, ("expires" , FileExpires -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON FileExpires
rootExpires)
, ("keys" , KeyEnv -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON KeyEnv
rootKeys)
, ("roles" , RootRoles -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON RootRoles
rootRoles)
]
instance Monad m => ToJSON m (RoleSpec a) where
toJSON :: RoleSpec a -> m JSValue
toJSON RoleSpec{..} = [(String, m JSValue)] -> m JSValue
forall (m :: * -> *). Monad m => [(String, m JSValue)] -> m JSValue
mkObject [
("keyids" , JSValue -> m JSValue
forall (m :: * -> *) a. Monad m => a -> m a
return (JSValue -> m JSValue)
-> ([Some PublicKey] -> JSValue) -> [Some PublicKey] -> m JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JSValue] -> JSValue
JSArray ([JSValue] -> JSValue)
-> ([Some PublicKey] -> [JSValue]) -> [Some PublicKey] -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Some PublicKey -> JSValue) -> [Some PublicKey] -> [JSValue]
forall a b. (a -> b) -> [a] -> [b]
map Some PublicKey -> JSValue
writeKeyAsId ([Some PublicKey] -> m JSValue) -> [Some PublicKey] -> m JSValue
forall a b. (a -> b) -> a -> b
$ [Some PublicKey]
roleSpecKeys)
, ("threshold" , KeyThreshold -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON KeyThreshold
roleSpecThreshold)
]
instance MonadKeys m => FromJSON m (Signed Root) where
fromJSON :: JSValue -> m (Signed Root)
fromJSON envelope :: JSValue
envelope = do
JSValue
enc <- JSValue -> String -> m JSValue
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
envelope "signed"
KeyEnv
rootKeys <- JSValue -> String -> m KeyEnv
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc "keys"
KeyEnv -> m (Signed Root) -> m (Signed Root)
forall (m :: * -> *) a. MonadKeys m => KeyEnv -> m a -> m a
withKeys KeyEnv
rootKeys (m (Signed Root) -> m (Signed Root))
-> m (Signed Root) -> m (Signed Root)
forall a b. (a -> b) -> a -> b
$ do
JSValue -> String -> m ()
forall (m :: * -> *).
(ReportSchemaErrors m, MonadError DeserializationError m) =>
JSValue -> String -> m ()
verifyType JSValue
enc "Root"
FileVersion
rootVersion <- JSValue -> String -> m FileVersion
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc "version"
FileExpires
rootExpires <- JSValue -> String -> m FileExpires
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc "expires"
RootRoles
rootRoles <- JSValue -> String -> m RootRoles
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc "roles"
let signed :: Root
signed = Root :: FileVersion -> FileExpires -> KeyEnv -> RootRoles -> Root
Root{..}
Signatures
signatures <- JSValue -> String -> m Signatures
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
envelope "signatures"
String -> Bool -> m ()
forall (m :: * -> *).
MonadError DeserializationError m =>
String -> Bool -> m ()
validate "signatures" (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ JSValue -> Signatures -> Bool
verifySignatures JSValue
enc Signatures
signatures
Signed Root -> m (Signed Root)
forall (m :: * -> *) a. Monad m => a -> m a
return Signed :: forall a. a -> Signatures -> Signed a
Signed{..}
instance MonadKeys m => FromJSON m (RoleSpec a) where
fromJSON :: JSValue -> m (RoleSpec a)
fromJSON enc :: JSValue
enc = do
[Some PublicKey]
roleSpecKeys <- (JSValue -> m (Some PublicKey)) -> [JSValue] -> m [Some PublicKey]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM JSValue -> m (Some PublicKey)
forall (m :: * -> *). MonadKeys m => JSValue -> m (Some PublicKey)
readKeyAsId ([JSValue] -> m [Some PublicKey])
-> m [JSValue] -> m [Some PublicKey]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSValue -> String -> m [JSValue]
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc "keyids"
KeyThreshold
roleSpecThreshold <- JSValue -> String -> m KeyThreshold
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc "threshold"
RoleSpec a -> m (RoleSpec a)
forall (m :: * -> *) a. Monad m => a -> m a
return RoleSpec :: forall a. [Some PublicKey] -> KeyThreshold -> RoleSpec a
RoleSpec{..}