module Hackage.Security.Key.Env (
    KeyEnv -- opaque
  , keyEnvMap
    -- * Convenience constructors
  , fromPublicKeys
  , fromKeys
    -- * The usual accessors
  , empty
  , null
  , insert
  , lookup
  , union
  ) where

import Prelude hiding (lookup, null)
import Control.Monad
import Data.Map (Map)
import qualified Data.Map as Map

import Hackage.Security.Key
import Hackage.Security.Util.JSON
import Hackage.Security.Util.Some

{-------------------------------------------------------------------------------
  Main datatype
-------------------------------------------------------------------------------}

-- | A key environment is a mapping from key IDs to the corresponding keys.
--
-- It should satisfy the invariant that these key IDs actually match the keys;
-- see 'checkKeyEnvInvariant'.
newtype KeyEnv = KeyEnv {
    KeyEnv -> Map KeyId (Some PublicKey)
keyEnvMap :: Map KeyId (Some PublicKey)
  }
  deriving (Int -> KeyEnv -> ShowS
[KeyEnv] -> ShowS
KeyEnv -> String
(Int -> KeyEnv -> ShowS)
-> (KeyEnv -> String) -> ([KeyEnv] -> ShowS) -> Show KeyEnv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyEnv -> ShowS
showsPrec :: Int -> KeyEnv -> ShowS
$cshow :: KeyEnv -> String
show :: KeyEnv -> String
$cshowList :: [KeyEnv] -> ShowS
showList :: [KeyEnv] -> ShowS
Show)

-- | Verify that each key ID is mapped to a key with that ID
checkKeyEnvInvariant :: KeyEnv -> Bool
checkKeyEnvInvariant :: KeyEnv -> Bool
checkKeyEnvInvariant = ((KeyId, Some PublicKey) -> Bool)
-> [(KeyId, Some PublicKey)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((KeyId -> Some PublicKey -> Bool)
-> (KeyId, Some PublicKey) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry KeyId -> Some PublicKey -> Bool
go) ([(KeyId, Some PublicKey)] -> Bool)
-> (KeyEnv -> [(KeyId, Some PublicKey)]) -> KeyEnv -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map KeyId (Some PublicKey) -> [(KeyId, Some PublicKey)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map KeyId (Some PublicKey) -> [(KeyId, Some PublicKey)])
-> (KeyEnv -> Map KeyId (Some PublicKey))
-> KeyEnv
-> [(KeyId, Some PublicKey)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyEnv -> Map KeyId (Some PublicKey)
keyEnvMap
  where
    go :: KeyId -> Some PublicKey -> Bool
    go :: KeyId -> Some PublicKey -> Bool
go KeyId
kId Some PublicKey
key = KeyId
kId KeyId -> KeyId -> Bool
forall a. Eq a => a -> a -> Bool
== Some PublicKey -> KeyId
forall (key :: * -> *). HasKeyId key => Some key -> KeyId
someKeyId Some PublicKey
key

{-------------------------------------------------------------------------------
  Convenience constructors
-------------------------------------------------------------------------------}

fromPublicKeys :: [Some PublicKey] -> KeyEnv
fromPublicKeys :: [Some PublicKey] -> KeyEnv
fromPublicKeys = Map KeyId (Some PublicKey) -> KeyEnv
KeyEnv (Map KeyId (Some PublicKey) -> KeyEnv)
-> ([Some PublicKey] -> Map KeyId (Some PublicKey))
-> [Some PublicKey]
-> KeyEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(KeyId, Some PublicKey)] -> Map KeyId (Some PublicKey)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(KeyId, Some PublicKey)] -> Map KeyId (Some PublicKey))
-> ([Some PublicKey] -> [(KeyId, Some PublicKey)])
-> [Some PublicKey]
-> Map KeyId (Some PublicKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Some PublicKey -> (KeyId, Some PublicKey))
-> [Some PublicKey] -> [(KeyId, Some PublicKey)]
forall a b. (a -> b) -> [a] -> [b]
map Some PublicKey -> (KeyId, Some PublicKey)
aux
  where
    aux :: Some PublicKey -> (KeyId, Some PublicKey)
    aux :: Some PublicKey -> (KeyId, Some PublicKey)
aux Some PublicKey
pub = (Some PublicKey -> KeyId
forall (key :: * -> *). HasKeyId key => Some key -> KeyId
someKeyId Some PublicKey
pub, Some PublicKey
pub)

fromKeys :: [Some Key] -> KeyEnv
fromKeys :: [Some Key] -> KeyEnv
fromKeys = [Some PublicKey] -> KeyEnv
fromPublicKeys ([Some PublicKey] -> KeyEnv)
-> ([Some Key] -> [Some PublicKey]) -> [Some Key] -> KeyEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Some Key -> Some PublicKey) -> [Some Key] -> [Some PublicKey]
forall a b. (a -> b) -> [a] -> [b]
map Some Key -> Some PublicKey
somePublicKey

{-------------------------------------------------------------------------------
  The usual accessors
-------------------------------------------------------------------------------}

empty :: KeyEnv
empty :: KeyEnv
empty = Map KeyId (Some PublicKey) -> KeyEnv
KeyEnv Map KeyId (Some PublicKey)
forall k a. Map k a
Map.empty

null :: KeyEnv -> Bool
null :: KeyEnv -> Bool
null (KeyEnv Map KeyId (Some PublicKey)
env) = Map KeyId (Some PublicKey) -> Bool
forall k a. Map k a -> Bool
Map.null Map KeyId (Some PublicKey)
env

insert :: Some PublicKey -> KeyEnv -> KeyEnv
insert :: Some PublicKey -> KeyEnv -> KeyEnv
insert Some PublicKey
key (KeyEnv Map KeyId (Some PublicKey)
env) = Map KeyId (Some PublicKey) -> KeyEnv
KeyEnv (Map KeyId (Some PublicKey) -> KeyEnv)
-> Map KeyId (Some PublicKey) -> KeyEnv
forall a b. (a -> b) -> a -> b
$ KeyId
-> Some PublicKey
-> Map KeyId (Some PublicKey)
-> Map KeyId (Some PublicKey)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Some PublicKey -> KeyId
forall (key :: * -> *). HasKeyId key => Some key -> KeyId
someKeyId Some PublicKey
key) Some PublicKey
key Map KeyId (Some PublicKey)
env

lookup :: KeyId -> KeyEnv -> Maybe (Some PublicKey)
lookup :: KeyId -> KeyEnv -> Maybe (Some PublicKey)
lookup KeyId
kId (KeyEnv Map KeyId (Some PublicKey)
env) = KeyId -> Map KeyId (Some PublicKey) -> Maybe (Some PublicKey)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyId
kId Map KeyId (Some PublicKey)
env

union :: KeyEnv -> KeyEnv -> KeyEnv
union :: KeyEnv -> KeyEnv -> KeyEnv
union (KeyEnv Map KeyId (Some PublicKey)
env) (KeyEnv Map KeyId (Some PublicKey)
env') = Map KeyId (Some PublicKey) -> KeyEnv
KeyEnv (Map KeyId (Some PublicKey)
env Map KeyId (Some PublicKey)
-> Map KeyId (Some PublicKey) -> Map KeyId (Some PublicKey)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map KeyId (Some PublicKey)
env')

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

instance Monad m => ToJSON m KeyEnv where
  toJSON :: KeyEnv -> m JSValue
toJSON (KeyEnv Map KeyId (Some PublicKey)
keyEnv) = Map KeyId (Some PublicKey) -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON Map KeyId (Some PublicKey)
keyEnv

instance ReportSchemaErrors m => FromJSON m KeyEnv where
  fromJSON :: JSValue -> m KeyEnv
fromJSON JSValue
enc = do
    KeyEnv
keyEnv <- Map KeyId (Some PublicKey) -> KeyEnv
KeyEnv (Map KeyId (Some PublicKey) -> KeyEnv)
-> m (Map KeyId (Some PublicKey)) -> m KeyEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> m (Map KeyId (Some PublicKey))
forall (m :: * -> *) a. FromJSON m a => JSValue -> m a
fromJSON JSValue
enc
    -- We should really use 'validate', but that causes module import cycles.
    -- Sigh.
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (KeyEnv -> Bool
checkKeyEnvInvariant KeyEnv
keyEnv) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      String -> Maybe String -> m ()
forall a. String -> Maybe String -> m a
forall (m :: * -> *) a.
ReportSchemaErrors m =>
String -> Maybe String -> m a
expected String
"valid key environment" Maybe String
forall a. Maybe a
Nothing
    KeyEnv -> m KeyEnv
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return KeyEnv
keyEnv