module Hackage.Security.TUF.Targets (
Targets(..)
, Delegations(..)
, DelegationSpec(..)
, Delegation(..)
, targetsLookup
) where
import Hackage.Security.JSON
import Hackage.Security.Key
import Hackage.Security.Key.Env (KeyEnv)
import Hackage.Security.TUF.Common
import Hackage.Security.TUF.FileInfo
import Hackage.Security.TUF.FileMap (FileMap, TargetPath)
import Hackage.Security.TUF.Header
import Hackage.Security.TUF.Patterns
import Hackage.Security.TUF.Signed
import Hackage.Security.Util.Some
import qualified Hackage.Security.TUF.FileMap as FileMap
data Targets = Targets {
Targets -> FileVersion
targetsVersion :: FileVersion
, Targets -> FileExpires
targetsExpires :: FileExpires
, Targets -> FileMap
targetsTargets :: FileMap
, Targets -> Maybe Delegations
targetsDelegations :: Maybe Delegations
}
deriving (Int -> Targets -> ShowS
[Targets] -> ShowS
Targets -> String
(Int -> Targets -> ShowS)
-> (Targets -> String) -> ([Targets] -> ShowS) -> Show Targets
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Targets] -> ShowS
$cshowList :: [Targets] -> ShowS
show :: Targets -> String
$cshow :: Targets -> String
showsPrec :: Int -> Targets -> ShowS
$cshowsPrec :: Int -> Targets -> ShowS
Show)
data Delegations = Delegations {
Delegations -> KeyEnv
delegationsKeys :: KeyEnv
, Delegations -> [DelegationSpec]
delegationsRoles :: [DelegationSpec]
}
deriving (Int -> Delegations -> ShowS
[Delegations] -> ShowS
Delegations -> String
(Int -> Delegations -> ShowS)
-> (Delegations -> String)
-> ([Delegations] -> ShowS)
-> Show Delegations
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Delegations] -> ShowS
$cshowList :: [Delegations] -> ShowS
show :: Delegations -> String
$cshow :: Delegations -> String
showsPrec :: Int -> Delegations -> ShowS
$cshowsPrec :: Int -> Delegations -> ShowS
Show)
data DelegationSpec = DelegationSpec {
DelegationSpec -> [Some PublicKey]
delegationSpecKeys :: [Some PublicKey]
, DelegationSpec -> KeyThreshold
delegationSpecThreshold :: KeyThreshold
, DelegationSpec -> Delegation
delegation :: Delegation
}
deriving (Int -> DelegationSpec -> ShowS
[DelegationSpec] -> ShowS
DelegationSpec -> String
(Int -> DelegationSpec -> ShowS)
-> (DelegationSpec -> String)
-> ([DelegationSpec] -> ShowS)
-> Show DelegationSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DelegationSpec] -> ShowS
$cshowList :: [DelegationSpec] -> ShowS
show :: DelegationSpec -> String
$cshow :: DelegationSpec -> String
showsPrec :: Int -> DelegationSpec -> ShowS
$cshowsPrec :: Int -> DelegationSpec -> ShowS
Show)
instance HasHeader Targets where
fileVersion :: LensLike f Targets Targets FileVersion FileVersion
fileVersion f :: FileVersion -> f FileVersion
f x :: Targets
x = (\y :: FileVersion
y -> Targets
x { targetsVersion :: FileVersion
targetsVersion = FileVersion
y }) (FileVersion -> Targets) -> f FileVersion -> f Targets
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileVersion -> f FileVersion
f (Targets -> FileVersion
targetsVersion Targets
x)
fileExpires :: LensLike f Targets Targets FileExpires FileExpires
fileExpires f :: FileExpires -> f FileExpires
f x :: Targets
x = (\y :: FileExpires
y -> Targets
x { targetsExpires :: FileExpires
targetsExpires = FileExpires
y }) (FileExpires -> Targets) -> f FileExpires -> f Targets
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileExpires -> f FileExpires
f (Targets -> FileExpires
targetsExpires Targets
x)
targetsLookup :: TargetPath -> Targets -> Maybe FileInfo
targetsLookup :: TargetPath -> Targets -> Maybe FileInfo
targetsLookup fp :: TargetPath
fp Targets{..} = TargetPath -> FileMap -> Maybe FileInfo
FileMap.lookup TargetPath
fp FileMap
targetsTargets
instance Monad m => ToJSON m DelegationSpec where
toJSON :: DelegationSpec -> m JSValue
toJSON DelegationSpec{delegation :: DelegationSpec -> Delegation
delegation = Delegation fp :: Pattern a
fp name :: Replacement a
name, ..} = [(String, m JSValue)] -> m JSValue
forall (m :: * -> *). Monad m => [(String, m JSValue)] -> m JSValue
mkObject [
("name" , Replacement a -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON Replacement a
name)
, ("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]
delegationSpecKeys)
, ("threshold" , KeyThreshold -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON KeyThreshold
delegationSpecThreshold)
, ("path" , Pattern a -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON Pattern a
fp)
]
instance MonadKeys m => FromJSON m DelegationSpec where
fromJSON :: JSValue -> m DelegationSpec
fromJSON enc :: JSValue
enc = do
String
delegationName <- JSValue -> String -> m String
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc "name"
[Some PublicKey]
delegationSpecKeys <- (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
delegationSpecThreshold <- JSValue -> String -> m KeyThreshold
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc "threshold"
String
delegationPath <- JSValue -> String -> m String
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc "path"
case String -> String -> Either String Delegation
parseDelegation String
delegationName String
delegationPath of
Left err :: String
err -> String -> Maybe String -> m DelegationSpec
forall (m :: * -> *) a.
ReportSchemaErrors m =>
String -> Maybe String -> m a
expected ("valid name/path combination: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err) Maybe String
forall a. Maybe a
Nothing
Right delegation :: Delegation
delegation -> DelegationSpec -> m DelegationSpec
forall (m :: * -> *) a. Monad m => a -> m a
return DelegationSpec :: [Some PublicKey] -> KeyThreshold -> Delegation -> DelegationSpec
DelegationSpec{..}
instance Monad m => ToJSON m Delegations where
toJSON :: Delegations -> m JSValue
toJSON Delegations{..} = [(String, m JSValue)] -> m JSValue
forall (m :: * -> *). Monad m => [(String, m JSValue)] -> m JSValue
mkObject [
("keys" , KeyEnv -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON KeyEnv
delegationsKeys)
, ("roles" , [DelegationSpec] -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON [DelegationSpec]
delegationsRoles)
]
instance MonadKeys m => FromJSON m Delegations where
fromJSON :: JSValue -> m Delegations
fromJSON enc :: JSValue
enc = do
KeyEnv
delegationsKeys <- JSValue -> String -> m KeyEnv
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc "keys"
[DelegationSpec]
delegationsRoles <- JSValue -> String -> m [DelegationSpec]
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc "roles"
Delegations -> m Delegations
forall (m :: * -> *) a. Monad m => a -> m a
return Delegations :: KeyEnv -> [DelegationSpec] -> Delegations
Delegations{..}
instance Monad m => ToJSON m Targets where
toJSON :: Targets -> m JSValue
toJSON Targets{..} = [(String, m JSValue)] -> m JSValue
forall (m :: * -> *). Monad m => [(String, m JSValue)] -> m JSValue
mkObject ([(String, m JSValue)] -> m JSValue)
-> [(String, m JSValue)] -> m JSValue
forall a b. (a -> b) -> a -> b
$ [[(String, m JSValue)]] -> [(String, m JSValue)]
forall a. Monoid a => [a] -> a
mconcat [
[ ("_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 "Targets")
, ("version" , FileVersion -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON FileVersion
targetsVersion)
, ("expires" , FileExpires -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON FileExpires
targetsExpires)
, ("targets" , FileMap -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON FileMap
targetsTargets)
]
, [ ("delegations" , Delegations -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON Delegations
d) | Just d :: Delegations
d <- [ Maybe Delegations
targetsDelegations ] ]
]
instance MonadKeys m => FromJSON m Targets where
fromJSON :: JSValue -> m Targets
fromJSON enc :: JSValue
enc = do
JSValue -> String -> m ()
forall (m :: * -> *).
(ReportSchemaErrors m, MonadError DeserializationError m) =>
JSValue -> String -> m ()
verifyType JSValue
enc "Targets"
FileVersion
targetsVersion <- JSValue -> String -> m FileVersion
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc "version"
FileExpires
targetsExpires <- JSValue -> String -> m FileExpires
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc "expires"
FileMap
targetsTargets <- JSValue -> String -> m FileMap
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc "targets"
Maybe Delegations
targetsDelegations <- JSValue -> String -> m (Maybe Delegations)
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m (Maybe a)
fromJSOptField JSValue
enc "delegations"
Targets -> m Targets
forall (m :: * -> *) a. Monad m => a -> m a
return Targets :: FileVersion
-> FileExpires -> FileMap -> Maybe Delegations -> Targets
Targets{..}
instance MonadKeys m => FromJSON m (Signed Targets) where
fromJSON :: JSValue -> m (Signed Targets)
fromJSON = JSValue -> m (Signed Targets)
forall (m :: * -> *) a.
(MonadKeys m, FromJSON m a) =>
JSValue -> m (Signed a)
signedFromJSON