    -- | The root filetype
    module Hackage.Security.TUF.Root (
        -- * Datatypes
        Root(..)
      , RootRoles(..)
      , RoleSpec(..)
      ) 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.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

    {-------------------------------------------------------------------------------
      Datatypes
    -------------------------------------------------------------------------------}

    -- | The root metadata
    --
    -- NOTE: We must have the invariant that ALL keys (apart from delegation keys)
    -- must be listed in 'rootKeys'. (Delegation keys satisfy a similar invariant,
    -- see Targets.)
    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
      }

    -- | Role specification
    --
    -- The phantom type indicates what kind of type this role is meant to verify.
    data RoleSpec a = RoleSpec {
        forall a. RoleSpec a -> [Some PublicKey]
    roleSpecKeys      :: [Some PublicKey]
      , forall a. 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
    $cshowsPrec :: forall a. Int -> RoleSpec a -> ShowS
    showsPrec :: Int -> RoleSpec a -> ShowS
    $cshow :: forall a. RoleSpec a -> String
    show :: RoleSpec a -> String
    $cshowList :: forall a. [RoleSpec a] -> ShowS
    showList :: [RoleSpec a] -> ShowS
    Show)

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

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

    instance Monad m => ToJSON m RootRoles where
      toJSON :: RootRoles -> m JSValue
    toJSON RootRoles{RoleSpec Mirrors
    RoleSpec Timestamp
    RoleSpec Targets
    RoleSpec Snapshot
    RoleSpec Root
    rootRolesRoot :: RootRoles -> RoleSpec Root
    rootRolesSnapshot :: RootRoles -> RoleSpec Snapshot
    rootRolesTargets :: RootRoles -> RoleSpec Targets
    rootRolesTimestamp :: RootRoles -> RoleSpec Timestamp
    rootRolesMirrors :: RootRoles -> RoleSpec Mirrors
    rootRolesRoot :: RoleSpec Root
    rootRolesSnapshot :: RoleSpec Snapshot
    rootRolesTargets :: RoleSpec Targets
    rootRolesTimestamp :: RoleSpec Timestamp
    rootRolesMirrors :: RoleSpec Mirrors
    ..} = [(String, m JSValue)] -> m JSValue
    forall (m :: * -> *). Monad m => [(String, m JSValue)] -> m JSValue
    mkObject [
          (String
    "root"      , RoleSpec Root -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON RoleSpec Root
    rootRolesRoot)
        , (String
    "snapshot"  , RoleSpec Snapshot -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON RoleSpec Snapshot
    rootRolesSnapshot)
        , (String
    "targets"   , RoleSpec Targets -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON RoleSpec Targets
    rootRolesTargets)
        , (String
    "timestamp" , RoleSpec Timestamp -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON RoleSpec Timestamp
    rootRolesTimestamp)
        , (String
    "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 JSValue
    enc = do
        rootRolesRoot      <- JSValue -> String -> m (RoleSpec Root)
    forall (m :: * -> *) a.
    (ReportSchemaErrors m, FromJSON m a) =>
    JSValue -> String -> m a
    fromJSField JSValue
    enc String
    "root"
        rootRolesSnapshot  <- fromJSField enc "snapshot"
        rootRolesTargets   <- fromJSField enc "targets"
        rootRolesTimestamp <- fromJSField enc "timestamp"
        rootRolesMirrors   <- fromJSField enc "mirrors"
        return RootRoles{..}

    instance Monad m => ToJSON m Root where
      toJSON :: Root -> m JSValue
    toJSON Root{KeyEnv
    FileExpires
    FileVersion
    RootRoles
    rootKeys :: Root -> KeyEnv
    rootVersion :: Root -> FileVersion
    rootExpires :: Root -> FileExpires
    rootRoles :: Root -> RootRoles
    rootVersion :: FileVersion
    rootExpires :: FileExpires
    rootKeys :: KeyEnv
    rootRoles :: RootRoles
    ..} = [(String, m JSValue)] -> m JSValue
    forall (m :: * -> *). Monad m => [(String, m JSValue)] -> m JSValue
    mkObject [
             (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
    "Root")
           , (String
    "version" , FileVersion -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON FileVersion
    rootVersion)
           , (String
    "expires" , FileExpires -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON FileExpires
    rootExpires)
           , (String
    "keys"    , KeyEnv -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON KeyEnv
    rootKeys)
           , (String
    "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{[Some PublicKey]
    KeyThreshold
    roleSpecKeys :: forall a. RoleSpec a -> [Some PublicKey]
    roleSpecThreshold :: forall a. RoleSpec a -> KeyThreshold
    roleSpecKeys :: [Some PublicKey]
    roleSpecThreshold :: KeyThreshold
    ..} = [(String, m JSValue)] -> m JSValue
    forall (m :: * -> *). Monad m => [(String, m JSValue)] -> m JSValue
    mkObject [
            (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]
    roleSpecKeys)
          , (String
    "threshold" , KeyThreshold -> m JSValue
    forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
    toJSON KeyThreshold
    roleSpecThreshold)
          ]

    -- | We give an instance for Signed Root rather than Root because the key
    -- environment from the root data is necessary to resolve the explicit sharing
    -- in the signatures.
    instance MonadKeys m => FromJSON m (Signed Root) where
      fromJSON :: JSValue -> m (Signed Root)
    fromJSON JSValue
    envelope = do
        enc      <- JSValue -> String -> m JSValue
    forall (m :: * -> *) a.
    (ReportSchemaErrors m, FromJSON m a) =>
    JSValue -> String -> m a
    fromJSField JSValue
    envelope String
    "signed"
        rootKeys <- fromJSField enc      "keys"
        withKeys rootKeys $ do
          verifyType enc "Root"
          rootVersion <- fromJSField enc "version"
          rootExpires <- fromJSField enc "expires"
          rootRoles   <- fromJSField enc "roles"
          let signed = Root{KeyEnv
    FileExpires
    FileVersion
    RootRoles
    rootKeys :: KeyEnv
    rootVersion :: FileVersion
    rootExpires :: FileExpires
    rootRoles :: RootRoles
    rootKeys :: KeyEnv
    rootVersion :: FileVersion
    rootExpires :: FileExpires
    rootRoles :: RootRoles
    ..}

          signatures <- fromJSField envelope "signatures"
          validate "signatures" $ verifySignatures enc signatures
          return Signed{..}

    instance MonadKeys m => FromJSON m (RoleSpec a) where
      fromJSON :: JSValue -> m (RoleSpec a)
    fromJSON JSValue
    enc = do
        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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 String
    "keyids"
        roleSpecThreshold <- fromJSField enc "threshold"
        return RoleSpec{..}