    module Hackage.Security.TUF.Targets (
        -- * TUF types
        Targets(..)
      , Delegations(..)
      , DelegationSpec(..)
      , Delegation(..)
        -- ** Util
      , targetsLookup
      ) where

    import Prelude
    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

    {-------------------------------------------------------------------------------
      TUF types
    -------------------------------------------------------------------------------}

    -- | Target metadata
    --
    -- Most target files do not need expiry dates because they are not subject to
    -- change (and hence attacks like freeze attacks are not a concern).
    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
    $cshowsPrec :: Int -> Targets -> ShowS
    showsPrec :: Int -> Targets -> ShowS
    $cshow :: Targets -> String
    show :: Targets -> String
    $cshowList :: [Targets] -> ShowS
    showList :: [Targets] -> ShowS
    Show)

    -- | Delegations
    --
    -- Much like the Root datatype, this must have an invariant that ALL used keys
    -- (apart from the global keys, which are in the root key environment) must
    -- be listed in 'delegationsKeys'.
    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
    $cshowsPrec :: Int -> Delegations -> ShowS
    showsPrec :: Int -> Delegations -> ShowS
    $cshow :: Delegations -> String
    show :: Delegations -> String
    $cshowList :: [Delegations] -> ShowS
    showList :: [Delegations] -> ShowS
    Show)

    -- | Delegation specification
    --
    -- NOTE: This is a close analogue of 'RoleSpec'.
    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
    $cshowsPrec :: Int -> DelegationSpec -> ShowS
    showsPrec :: Int -> DelegationSpec -> ShowS
    $cshow :: DelegationSpec -> String
    show :: DelegationSpec -> String
    $cshowList :: [DelegationSpec] -> ShowS
    showList :: [DelegationSpec] -> ShowS
    Show)

    instance HasHeader Targets where
      fileVersion :: Lens' Targets FileVersion
    fileVersion FileVersion -> f FileVersion
    f Targets
    x = (\FileVersion
    y -> Targets
    x { targetsVersion = 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 :: Lens' Targets FileExpires
    fileExpires FileExpires -> f FileExpires
    f Targets
    x = (\FileExpires
    y -> Targets
    x { targetsExpires = 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)

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

    targetsLookup :: TargetPath -> Targets -> Maybe FileInfo
    targetsLookup :: TargetPath -> Targets -> Maybe FileInfo
    targetsLookup TargetPath
    fp Targets{Maybe Delegations
    FileExpires
    FileVersion
    FileMap
    targetsVersion :: Targets -> FileVersion
    targetsExpires :: Targets -> FileExpires
    targetsTargets :: Targets -> FileMap
    targetsDelegations :: Targets -> Maybe Delegations
    targetsVersion :: FileVersion
    targetsExpires :: FileExpires
    targetsTargets :: FileMap
    targetsDelegations :: Maybe Delegations
    ..} = TargetPath -> FileMap -> Maybe FileInfo
    FileMap.lookup TargetPath
    fp FileMap
    targetsTargets

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

    instance Monad m => ToJSON m DelegationSpec where
      toJSON :: DelegationSpec -> m JSValue
    toJSON DelegationSpec{delegation :: DelegationSpec -> Delegation
    delegation = Delegation Pattern a
    fp Replacement a
    name, [Some PublicKey]
    KeyThreshold
    delegationSpecKeys :: DelegationSpec -> [Some PublicKey]
    delegationSpecThreshold :: DelegationSpec -> KeyThreshold
    delegationSpecKeys :: [Some PublicKey]
    delegationSpecThreshold :: KeyThreshold
    ..} = [(String, m JSValue)] -> m JSValue
    forall (m :: * -> *). Monad m => [(String, m JSValue)] -> m JSValue
    mkObject [
            (String
    "name"      , Replacement a -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON Replacement a
    name)
          , (String
    "keyids"    , JSValue -> m JSValue
    forall a. a -> m a
    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)
          , (String
    "threshold" , KeyThreshold -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON KeyThreshold
    delegationSpecThreshold)
          , (String
    "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 JSValue
    enc = do
        delegationName          <- JSValue -> String -> m String
    forall (m :: * -> *) a.
    (ReportSchemaErrors m, FromJSON m a) =>
    JSValue -> String -> m a
    fromJSField JSValue
    enc String
    "name"
        delegationSpecKeys      <- mapM readKeyAsId =<< fromJSField enc "keyids"
        delegationSpecThreshold <- fromJSField enc "threshold"
        delegationPath          <- fromJSField enc "path"
        case parseDelegation delegationName delegationPath of
          Left  String
    err        -> String -> Maybe String -> m DelegationSpec
    forall a. String -> Maybe String -> m a
    forall (m :: * -> *) a.
    ReportSchemaErrors m =>
    String -> Maybe String -> m a
    expected (String
    "valid name/path combination: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    err) Maybe String
    forall a. Maybe a
    Nothing
          Right Delegation
    delegation -> DelegationSpec -> m DelegationSpec
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return DelegationSpec{[Some PublicKey]
    Delegation
    KeyThreshold
    delegationSpecKeys :: [Some PublicKey]
    delegationSpecThreshold :: KeyThreshold
    delegation :: Delegation
    delegationSpecKeys :: [Some PublicKey]
    delegationSpecThreshold :: KeyThreshold
    delegation :: Delegation
    ..}

    -- NOTE: Unlike the Root object, the keys that are used to sign the delegations
    -- are NOT listed inside the delegations, so the same "bootstrapping" problems
    -- do not arise here.
    instance Monad m => ToJSON m Delegations where
      toJSON :: Delegations -> m JSValue
    toJSON Delegations{[DelegationSpec]
    KeyEnv
    delegationsKeys :: Delegations -> KeyEnv
    delegationsRoles :: Delegations -> [DelegationSpec]
    delegationsKeys :: KeyEnv
    delegationsRoles :: [DelegationSpec]
    ..} = [(String, m JSValue)] -> m JSValue
    forall (m :: * -> *). Monad m => [(String, m JSValue)] -> m JSValue
    mkObject [
            (String
    "keys"  , KeyEnv -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON KeyEnv
    delegationsKeys)
          , (String
    "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 JSValue
    enc = do
        delegationsKeys  <- JSValue -> String -> m KeyEnv
    forall (m :: * -> *) a.
    (ReportSchemaErrors m, FromJSON m a) =>
    JSValue -> String -> m a
    fromJSField JSValue
    enc String
    "keys"
        delegationsRoles <- fromJSField enc "roles"
        return Delegations{..}

    instance Monad m => ToJSON m Targets where
      toJSON :: Targets -> m JSValue
    toJSON Targets{Maybe Delegations
    FileExpires
    FileVersion
    FileMap
    targetsVersion :: Targets -> FileVersion
    targetsExpires :: Targets -> FileExpires
    targetsTargets :: Targets -> FileMap
    targetsDelegations :: Targets -> Maybe Delegations
    targetsVersion :: FileVersion
    targetsExpires :: FileExpires
    targetsTargets :: FileMap
    targetsDelegations :: Maybe Delegations
    ..} = [(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 [
          [ (String
    "_type"       , JSValue -> m JSValue
    forall a. a -> m a
    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 String
    "Targets")
          , (String
    "version"     , FileVersion -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON FileVersion
    targetsVersion)
          , (String
    "expires"     , FileExpires -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON FileExpires
    targetsExpires)
          , (String
    "targets"     , FileMap -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON FileMap
    targetsTargets)
          ]
        , [ (String
    "delegations" , Delegations -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON Delegations
    d) | Just Delegations
    d <- [ Maybe Delegations
    targetsDelegations ] ]
        ]

    instance MonadKeys m => FromJSON m Targets where
      fromJSON :: JSValue -> m Targets
    fromJSON JSValue
    enc = do
        JSValue -> String -> m ()
    forall (m :: * -> *).
    (ReportSchemaErrors m, MonadError DeserializationError m) =>
    JSValue -> String -> m ()
    verifyType JSValue
    enc String
    "Targets"
        targetsVersion     <- JSValue -> String -> m FileVersion
    forall (m :: * -> *) a.
    (ReportSchemaErrors m, FromJSON m a) =>
    JSValue -> String -> m a
    fromJSField    JSValue
    enc String
    "version"
        targetsExpires     <- fromJSField    enc "expires"
        targetsTargets     <- fromJSField    enc "targets"
        targetsDelegations <- fromJSOptField enc "delegations"
        return Targets{..}

    -- TODO: This is okay right now because targets do not introduce additional
    -- keys, but will no longer be okay once we have author keys.
    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