-- | Hackage-specific wrappers around the Util.JSON module
{-# LANGUAGE CPP #-}
module Hackage.Security.JSON (
    -- * Deserialization errors
    DeserializationError(..)
  , validate
  , verifyType
    -- * MonadKeys
  , MonadKeys(..)
  , addKeys
  , withKeys
  , lookupKey
  , readKeyAsId
    -- * Reader monads
  , ReadJSON_Keys_Layout
  , ReadJSON_Keys_NoLayout
  , ReadJSON_NoKeys_NoLayout
  , runReadJSON_Keys_Layout
  , runReadJSON_Keys_NoLayout
  , runReadJSON_NoKeys_NoLayout
    -- ** Utility
  , parseJSON_Keys_Layout
  , parseJSON_Keys_NoLayout
  , parseJSON_NoKeys_NoLayout
  , readJSON_Keys_Layout
  , readJSON_Keys_NoLayout
  , readJSON_NoKeys_NoLayout
    -- * Writing
  , WriteJSON
  , runWriteJSON
    -- ** Utility
  , renderJSON
  , renderJSON_NoLayout
  , writeJSON
  , writeJSON_NoLayout
  , writeKeyAsId
    -- * Re-exports
  , module Hackage.Security.Util.JSON
  ) where

import Prelude
import Control.Arrow (first, second)
import Control.Exception
import Control.Monad (unless, liftM)
import Control.Monad.Except (MonadError, Except, ExceptT, runExcept, runExceptT, throwError)
import Control.Monad.Reader (MonadReader, Reader, runReader, local, ask)
import Data.Functor.Identity
import Data.Typeable (Typeable)
import qualified Data.ByteString.Lazy as BS.L

import Hackage.Security.Key
import Hackage.Security.Key.Env (KeyEnv)
import Hackage.Security.TUF.Layout.Repo
import Hackage.Security.Util.JSON
import Hackage.Security.Util.Path
import Hackage.Security.Util.Pretty
import Hackage.Security.Util.Some
import Text.JSON.Canonical
import qualified Hackage.Security.Key.Env as KeyEnv

{-------------------------------------------------------------------------------
  Deserialization errors
-------------------------------------------------------------------------------}

data DeserializationError =
    -- | Malformed JSON has syntax errors in the JSON itself
    -- (i.e., we cannot even parse it to a JSValue)
    DeserializationErrorMalformed String

    -- | Invalid JSON has valid syntax but invalid structure
    --
    -- The string gives a hint about what we expected instead
  | DeserializationErrorSchema String

    -- | The JSON file contains a key ID of an unknown key
  | DeserializationErrorUnknownKey KeyId

    -- | Some verification step failed
  | DeserializationErrorValidation String

    -- | Wrong file type
    --
    -- Records actual and expected types.
  | DeserializationErrorFileType String String
  deriving (Typeable)

deriving instance Show DeserializationError
instance Exception DeserializationError where displayException :: DeserializationError -> String
displayException = DeserializationError -> String
forall a. Pretty a => a -> String
pretty

instance Pretty DeserializationError where
  pretty :: DeserializationError -> String
pretty (DeserializationErrorMalformed String
str) =
      String
"Malformed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str
  pretty (DeserializationErrorSchema String
str) =
      String
"Schema error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str
  pretty (DeserializationErrorUnknownKey KeyId
kId) =
      String
"Unknown key: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ KeyId -> String
keyIdString KeyId
kId
  pretty (DeserializationErrorValidation String
str) =
      String
"Invalid: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str
  pretty (DeserializationErrorFileType String
actualType String
expectedType) =
         String
"Expected file of type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
expectedType
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" but got file of type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
actualType

validate :: MonadError DeserializationError m => String -> Bool -> m ()
validate :: forall (m :: * -> *).
MonadError DeserializationError m =>
String -> Bool -> m ()
validate String
_   Bool
True  = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
validate String
msg Bool
False = DeserializationError -> m ()
forall a. DeserializationError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DeserializationError -> m ()) -> DeserializationError -> m ()
forall a b. (a -> b) -> a -> b
$ String -> DeserializationError
DeserializationErrorValidation String
msg

verifyType :: (ReportSchemaErrors m, MonadError DeserializationError m)
           => JSValue -> String -> m ()
verifyType :: forall (m :: * -> *).
(ReportSchemaErrors m, MonadError DeserializationError m) =>
JSValue -> String -> m ()
verifyType JSValue
enc String
expectedType = do
    String
actualType <- JSValue -> String -> m String
forall (m :: * -> *) a.
(ReportSchemaErrors m, FromJSON m a) =>
JSValue -> String -> m a
fromJSField JSValue
enc String
"_type"
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String
actualType String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
expectedType) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      DeserializationError -> m ()
forall a. DeserializationError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DeserializationError -> m ()) -> DeserializationError -> m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> DeserializationError
DeserializationErrorFileType String
actualType String
expectedType

{-------------------------------------------------------------------------------
  Access to keys
-------------------------------------------------------------------------------}

-- | MonadReader-like monad, specialized to key environments
class (ReportSchemaErrors m, MonadError DeserializationError m) => MonadKeys m where
  localKeys :: (KeyEnv -> KeyEnv) -> m a -> m a
  askKeys   :: m KeyEnv

readKeyAsId :: MonadKeys m => JSValue -> m (Some PublicKey)
readKeyAsId :: forall (m :: * -> *). MonadKeys m => JSValue -> m (Some PublicKey)
readKeyAsId (JSString String
kId) = KeyId -> m (Some PublicKey)
forall (m :: * -> *). MonadKeys m => KeyId -> m (Some PublicKey)
lookupKey (String -> KeyId
KeyId String
kId)
readKeyAsId JSValue
val            = String -> JSValue -> m (Some PublicKey)
forall (m :: * -> *) a.
ReportSchemaErrors m =>
String -> JSValue -> m a
expected' String
"key ID" JSValue
val

addKeys :: MonadKeys m => KeyEnv -> m a -> m a
addKeys :: forall (m :: * -> *) a. MonadKeys m => KeyEnv -> m a -> m a
addKeys KeyEnv
keys = (KeyEnv -> KeyEnv) -> m a -> m a
forall a. (KeyEnv -> KeyEnv) -> m a -> m a
forall (m :: * -> *) a.
MonadKeys m =>
(KeyEnv -> KeyEnv) -> m a -> m a
localKeys (KeyEnv -> KeyEnv -> KeyEnv
KeyEnv.union KeyEnv
keys)

withKeys :: MonadKeys m => KeyEnv -> m a -> m a
withKeys :: forall (m :: * -> *) a. MonadKeys m => KeyEnv -> m a -> m a
withKeys KeyEnv
keys = (KeyEnv -> KeyEnv) -> m a -> m a
forall a. (KeyEnv -> KeyEnv) -> m a -> m a
forall (m :: * -> *) a.
MonadKeys m =>
(KeyEnv -> KeyEnv) -> m a -> m a
localKeys (KeyEnv -> KeyEnv -> KeyEnv
forall a b. a -> b -> a
const KeyEnv
keys)

lookupKey :: MonadKeys m => KeyId -> m (Some PublicKey)
lookupKey :: forall (m :: * -> *). MonadKeys m => KeyId -> m (Some PublicKey)
lookupKey KeyId
kId = do
    KeyEnv
keyEnv <- m KeyEnv
forall (m :: * -> *). MonadKeys m => m KeyEnv
askKeys
    case KeyId -> KeyEnv -> Maybe (Some PublicKey)
KeyEnv.lookup KeyId
kId KeyEnv
keyEnv of
      Just Some PublicKey
key -> Some PublicKey -> m (Some PublicKey)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Some PublicKey
key
      Maybe (Some PublicKey)
Nothing  -> DeserializationError -> m (Some PublicKey)
forall a. DeserializationError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DeserializationError -> m (Some PublicKey))
-> DeserializationError -> m (Some PublicKey)
forall a b. (a -> b) -> a -> b
$ KeyId -> DeserializationError
DeserializationErrorUnknownKey KeyId
kId

{-------------------------------------------------------------------------------
  Reading
-------------------------------------------------------------------------------}

newtype ReadJSON_Keys_Layout a = ReadJSON_Keys_Layout {
    forall a.
ReadJSON_Keys_Layout a
-> ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
unReadJSON_Keys_Layout :: ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
  }
  deriving ( (forall a b.
 (a -> b) -> ReadJSON_Keys_Layout a -> ReadJSON_Keys_Layout b)
-> (forall a b.
    a -> ReadJSON_Keys_Layout b -> ReadJSON_Keys_Layout a)
-> Functor ReadJSON_Keys_Layout
forall a b. a -> ReadJSON_Keys_Layout b -> ReadJSON_Keys_Layout a
forall a b.
(a -> b) -> ReadJSON_Keys_Layout a -> ReadJSON_Keys_Layout b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b.
(a -> b) -> ReadJSON_Keys_Layout a -> ReadJSON_Keys_Layout b
fmap :: forall a b.
(a -> b) -> ReadJSON_Keys_Layout a -> ReadJSON_Keys_Layout b
$c<$ :: forall a b. a -> ReadJSON_Keys_Layout b -> ReadJSON_Keys_Layout a
<$ :: forall a b. a -> ReadJSON_Keys_Layout b -> ReadJSON_Keys_Layout a
Functor
           , Functor ReadJSON_Keys_Layout
Functor ReadJSON_Keys_Layout =>
(forall a. a -> ReadJSON_Keys_Layout a)
-> (forall a b.
    ReadJSON_Keys_Layout (a -> b)
    -> ReadJSON_Keys_Layout a -> ReadJSON_Keys_Layout b)
-> (forall a b c.
    (a -> b -> c)
    -> ReadJSON_Keys_Layout a
    -> ReadJSON_Keys_Layout b
    -> ReadJSON_Keys_Layout c)
-> (forall a b.
    ReadJSON_Keys_Layout a
    -> ReadJSON_Keys_Layout b -> ReadJSON_Keys_Layout b)
-> (forall a b.
    ReadJSON_Keys_Layout a
    -> ReadJSON_Keys_Layout b -> ReadJSON_Keys_Layout a)
-> Applicative ReadJSON_Keys_Layout
forall a. a -> ReadJSON_Keys_Layout a
forall a b.
ReadJSON_Keys_Layout a
-> ReadJSON_Keys_Layout b -> ReadJSON_Keys_Layout a
forall a b.
ReadJSON_Keys_Layout a
-> ReadJSON_Keys_Layout b -> ReadJSON_Keys_Layout b
forall a b.
ReadJSON_Keys_Layout (a -> b)
-> ReadJSON_Keys_Layout a -> ReadJSON_Keys_Layout b
forall a b c.
(a -> b -> c)
-> ReadJSON_Keys_Layout a
-> ReadJSON_Keys_Layout b
-> ReadJSON_Keys_Layout c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> ReadJSON_Keys_Layout a
pure :: forall a. a -> ReadJSON_Keys_Layout a
$c<*> :: forall a b.
ReadJSON_Keys_Layout (a -> b)
-> ReadJSON_Keys_Layout a -> ReadJSON_Keys_Layout b
<*> :: forall a b.
ReadJSON_Keys_Layout (a -> b)
-> ReadJSON_Keys_Layout a -> ReadJSON_Keys_Layout b
$cliftA2 :: forall a b c.
(a -> b -> c)
-> ReadJSON_Keys_Layout a
-> ReadJSON_Keys_Layout b
-> ReadJSON_Keys_Layout c
liftA2 :: forall a b c.
(a -> b -> c)
-> ReadJSON_Keys_Layout a
-> ReadJSON_Keys_Layout b
-> ReadJSON_Keys_Layout c
$c*> :: forall a b.
ReadJSON_Keys_Layout a
-> ReadJSON_Keys_Layout b -> ReadJSON_Keys_Layout b
*> :: forall a b.
ReadJSON_Keys_Layout a
-> ReadJSON_Keys_Layout b -> ReadJSON_Keys_Layout b
$c<* :: forall a b.
ReadJSON_Keys_Layout a
-> ReadJSON_Keys_Layout b -> ReadJSON_Keys_Layout a
<* :: forall a b.
ReadJSON_Keys_Layout a
-> ReadJSON_Keys_Layout b -> ReadJSON_Keys_Layout a
Applicative
           , Applicative ReadJSON_Keys_Layout
Applicative ReadJSON_Keys_Layout =>
(forall a b.
 ReadJSON_Keys_Layout a
 -> (a -> ReadJSON_Keys_Layout b) -> ReadJSON_Keys_Layout b)
-> (forall a b.
    ReadJSON_Keys_Layout a
    -> ReadJSON_Keys_Layout b -> ReadJSON_Keys_Layout b)
-> (forall a. a -> ReadJSON_Keys_Layout a)
-> Monad ReadJSON_Keys_Layout
forall a. a -> ReadJSON_Keys_Layout a
forall a b.
ReadJSON_Keys_Layout a
-> ReadJSON_Keys_Layout b -> ReadJSON_Keys_Layout b
forall a b.
ReadJSON_Keys_Layout a
-> (a -> ReadJSON_Keys_Layout b) -> ReadJSON_Keys_Layout b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b.
ReadJSON_Keys_Layout a
-> (a -> ReadJSON_Keys_Layout b) -> ReadJSON_Keys_Layout b
>>= :: forall a b.
ReadJSON_Keys_Layout a
-> (a -> ReadJSON_Keys_Layout b) -> ReadJSON_Keys_Layout b
$c>> :: forall a b.
ReadJSON_Keys_Layout a
-> ReadJSON_Keys_Layout b -> ReadJSON_Keys_Layout b
>> :: forall a b.
ReadJSON_Keys_Layout a
-> ReadJSON_Keys_Layout b -> ReadJSON_Keys_Layout b
$creturn :: forall a. a -> ReadJSON_Keys_Layout a
return :: forall a. a -> ReadJSON_Keys_Layout a
Monad
           , MonadError DeserializationError
           )

newtype ReadJSON_Keys_NoLayout a = ReadJSON_Keys_NoLayout {
    forall a.
ReadJSON_Keys_NoLayout a
-> ExceptT DeserializationError (Reader KeyEnv) a
unReadJSON_Keys_NoLayout :: ExceptT DeserializationError (Reader KeyEnv) a
  }
  deriving ( (forall a b.
 (a -> b) -> ReadJSON_Keys_NoLayout a -> ReadJSON_Keys_NoLayout b)
-> (forall a b.
    a -> ReadJSON_Keys_NoLayout b -> ReadJSON_Keys_NoLayout a)
-> Functor ReadJSON_Keys_NoLayout
forall a b.
a -> ReadJSON_Keys_NoLayout b -> ReadJSON_Keys_NoLayout a
forall a b.
(a -> b) -> ReadJSON_Keys_NoLayout a -> ReadJSON_Keys_NoLayout b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b.
(a -> b) -> ReadJSON_Keys_NoLayout a -> ReadJSON_Keys_NoLayout b
fmap :: forall a b.
(a -> b) -> ReadJSON_Keys_NoLayout a -> ReadJSON_Keys_NoLayout b
$c<$ :: forall a b.
a -> ReadJSON_Keys_NoLayout b -> ReadJSON_Keys_NoLayout a
<$ :: forall a b.
a -> ReadJSON_Keys_NoLayout b -> ReadJSON_Keys_NoLayout a
Functor
           , Functor ReadJSON_Keys_NoLayout
Functor ReadJSON_Keys_NoLayout =>
(forall a. a -> ReadJSON_Keys_NoLayout a)
-> (forall a b.
    ReadJSON_Keys_NoLayout (a -> b)
    -> ReadJSON_Keys_NoLayout a -> ReadJSON_Keys_NoLayout b)
-> (forall a b c.
    (a -> b -> c)
    -> ReadJSON_Keys_NoLayout a
    -> ReadJSON_Keys_NoLayout b
    -> ReadJSON_Keys_NoLayout c)
-> (forall a b.
    ReadJSON_Keys_NoLayout a
    -> ReadJSON_Keys_NoLayout b -> ReadJSON_Keys_NoLayout b)
-> (forall a b.
    ReadJSON_Keys_NoLayout a
    -> ReadJSON_Keys_NoLayout b -> ReadJSON_Keys_NoLayout a)
-> Applicative ReadJSON_Keys_NoLayout
forall a. a -> ReadJSON_Keys_NoLayout a
forall a b.
ReadJSON_Keys_NoLayout a
-> ReadJSON_Keys_NoLayout b -> ReadJSON_Keys_NoLayout a
forall a b.
ReadJSON_Keys_NoLayout a
-> ReadJSON_Keys_NoLayout b -> ReadJSON_Keys_NoLayout b
forall a b.
ReadJSON_Keys_NoLayout (a -> b)
-> ReadJSON_Keys_NoLayout a -> ReadJSON_Keys_NoLayout b
forall a b c.
(a -> b -> c)
-> ReadJSON_Keys_NoLayout a
-> ReadJSON_Keys_NoLayout b
-> ReadJSON_Keys_NoLayout c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> ReadJSON_Keys_NoLayout a
pure :: forall a. a -> ReadJSON_Keys_NoLayout a
$c<*> :: forall a b.
ReadJSON_Keys_NoLayout (a -> b)
-> ReadJSON_Keys_NoLayout a -> ReadJSON_Keys_NoLayout b
<*> :: forall a b.
ReadJSON_Keys_NoLayout (a -> b)
-> ReadJSON_Keys_NoLayout a -> ReadJSON_Keys_NoLayout b
$cliftA2 :: forall a b c.
(a -> b -> c)
-> ReadJSON_Keys_NoLayout a
-> ReadJSON_Keys_NoLayout b
-> ReadJSON_Keys_NoLayout c
liftA2 :: forall a b c.
(a -> b -> c)
-> ReadJSON_Keys_NoLayout a
-> ReadJSON_Keys_NoLayout b
-> ReadJSON_Keys_NoLayout c
$c*> :: forall a b.
ReadJSON_Keys_NoLayout a
-> ReadJSON_Keys_NoLayout b -> ReadJSON_Keys_NoLayout b
*> :: forall a b.
ReadJSON_Keys_NoLayout a
-> ReadJSON_Keys_NoLayout b -> ReadJSON_Keys_NoLayout b
$c<* :: forall a b.
ReadJSON_Keys_NoLayout a
-> ReadJSON_Keys_NoLayout b -> ReadJSON_Keys_NoLayout a
<* :: forall a b.
ReadJSON_Keys_NoLayout a
-> ReadJSON_Keys_NoLayout b -> ReadJSON_Keys_NoLayout a
Applicative
           , Applicative ReadJSON_Keys_NoLayout
Applicative ReadJSON_Keys_NoLayout =>
(forall a b.
 ReadJSON_Keys_NoLayout a
 -> (a -> ReadJSON_Keys_NoLayout b) -> ReadJSON_Keys_NoLayout b)
-> (forall a b.
    ReadJSON_Keys_NoLayout a
    -> ReadJSON_Keys_NoLayout b -> ReadJSON_Keys_NoLayout b)
-> (forall a. a -> ReadJSON_Keys_NoLayout a)
-> Monad ReadJSON_Keys_NoLayout
forall a. a -> ReadJSON_Keys_NoLayout a
forall a b.
ReadJSON_Keys_NoLayout a
-> ReadJSON_Keys_NoLayout b -> ReadJSON_Keys_NoLayout b
forall a b.
ReadJSON_Keys_NoLayout a
-> (a -> ReadJSON_Keys_NoLayout b) -> ReadJSON_Keys_NoLayout b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b.
ReadJSON_Keys_NoLayout a
-> (a -> ReadJSON_Keys_NoLayout b) -> ReadJSON_Keys_NoLayout b
>>= :: forall a b.
ReadJSON_Keys_NoLayout a
-> (a -> ReadJSON_Keys_NoLayout b) -> ReadJSON_Keys_NoLayout b
$c>> :: forall a b.
ReadJSON_Keys_NoLayout a
-> ReadJSON_Keys_NoLayout b -> ReadJSON_Keys_NoLayout b
>> :: forall a b.
ReadJSON_Keys_NoLayout a
-> ReadJSON_Keys_NoLayout b -> ReadJSON_Keys_NoLayout b
$creturn :: forall a. a -> ReadJSON_Keys_NoLayout a
return :: forall a. a -> ReadJSON_Keys_NoLayout a
Monad
           , MonadError DeserializationError
           )

newtype ReadJSON_NoKeys_NoLayout a = ReadJSON_NoKeys_NoLayout {
    forall a.
ReadJSON_NoKeys_NoLayout a -> Except DeserializationError a
unReadJSON_NoKeys_NoLayout :: Except DeserializationError a
  }
  deriving ( (forall a b.
 (a -> b)
 -> ReadJSON_NoKeys_NoLayout a -> ReadJSON_NoKeys_NoLayout b)
-> (forall a b.
    a -> ReadJSON_NoKeys_NoLayout b -> ReadJSON_NoKeys_NoLayout a)
-> Functor ReadJSON_NoKeys_NoLayout
forall a b.
a -> ReadJSON_NoKeys_NoLayout b -> ReadJSON_NoKeys_NoLayout a
forall a b.
(a -> b)
-> ReadJSON_NoKeys_NoLayout a -> ReadJSON_NoKeys_NoLayout b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b.
(a -> b)
-> ReadJSON_NoKeys_NoLayout a -> ReadJSON_NoKeys_NoLayout b
fmap :: forall a b.
(a -> b)
-> ReadJSON_NoKeys_NoLayout a -> ReadJSON_NoKeys_NoLayout b
$c<$ :: forall a b.
a -> ReadJSON_NoKeys_NoLayout b -> ReadJSON_NoKeys_NoLayout a
<$ :: forall a b.
a -> ReadJSON_NoKeys_NoLayout b -> ReadJSON_NoKeys_NoLayout a
Functor
           , Functor ReadJSON_NoKeys_NoLayout
Functor ReadJSON_NoKeys_NoLayout =>
(forall a. a -> ReadJSON_NoKeys_NoLayout a)
-> (forall a b.
    ReadJSON_NoKeys_NoLayout (a -> b)
    -> ReadJSON_NoKeys_NoLayout a -> ReadJSON_NoKeys_NoLayout b)
-> (forall a b c.
    (a -> b -> c)
    -> ReadJSON_NoKeys_NoLayout a
    -> ReadJSON_NoKeys_NoLayout b
    -> ReadJSON_NoKeys_NoLayout c)
-> (forall a b.
    ReadJSON_NoKeys_NoLayout a
    -> ReadJSON_NoKeys_NoLayout b -> ReadJSON_NoKeys_NoLayout b)
-> (forall a b.
    ReadJSON_NoKeys_NoLayout a
    -> ReadJSON_NoKeys_NoLayout b -> ReadJSON_NoKeys_NoLayout a)
-> Applicative ReadJSON_NoKeys_NoLayout
forall a. a -> ReadJSON_NoKeys_NoLayout a
forall a b.
ReadJSON_NoKeys_NoLayout a
-> ReadJSON_NoKeys_NoLayout b -> ReadJSON_NoKeys_NoLayout a
forall a b.
ReadJSON_NoKeys_NoLayout a
-> ReadJSON_NoKeys_NoLayout b -> ReadJSON_NoKeys_NoLayout b
forall a b.
ReadJSON_NoKeys_NoLayout (a -> b)
-> ReadJSON_NoKeys_NoLayout a -> ReadJSON_NoKeys_NoLayout b
forall a b c.
(a -> b -> c)
-> ReadJSON_NoKeys_NoLayout a
-> ReadJSON_NoKeys_NoLayout b
-> ReadJSON_NoKeys_NoLayout c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> ReadJSON_NoKeys_NoLayout a
pure :: forall a. a -> ReadJSON_NoKeys_NoLayout a
$c<*> :: forall a b.
ReadJSON_NoKeys_NoLayout (a -> b)
-> ReadJSON_NoKeys_NoLayout a -> ReadJSON_NoKeys_NoLayout b
<*> :: forall a b.
ReadJSON_NoKeys_NoLayout (a -> b)
-> ReadJSON_NoKeys_NoLayout a -> ReadJSON_NoKeys_NoLayout b
$cliftA2 :: forall a b c.
(a -> b -> c)
-> ReadJSON_NoKeys_NoLayout a
-> ReadJSON_NoKeys_NoLayout b
-> ReadJSON_NoKeys_NoLayout c
liftA2 :: forall a b c.
(a -> b -> c)
-> ReadJSON_NoKeys_NoLayout a
-> ReadJSON_NoKeys_NoLayout b
-> ReadJSON_NoKeys_NoLayout c
$c*> :: forall a b.
ReadJSON_NoKeys_NoLayout a
-> ReadJSON_NoKeys_NoLayout b -> ReadJSON_NoKeys_NoLayout b
*> :: forall a b.
ReadJSON_NoKeys_NoLayout a
-> ReadJSON_NoKeys_NoLayout b -> ReadJSON_NoKeys_NoLayout b
$c<* :: forall a b.
ReadJSON_NoKeys_NoLayout a
-> ReadJSON_NoKeys_NoLayout b -> ReadJSON_NoKeys_NoLayout a
<* :: forall a b.
ReadJSON_NoKeys_NoLayout a
-> ReadJSON_NoKeys_NoLayout b -> ReadJSON_NoKeys_NoLayout a
Applicative
           , Applicative ReadJSON_NoKeys_NoLayout
Applicative ReadJSON_NoKeys_NoLayout =>
(forall a b.
 ReadJSON_NoKeys_NoLayout a
 -> (a -> ReadJSON_NoKeys_NoLayout b) -> ReadJSON_NoKeys_NoLayout b)
-> (forall a b.
    ReadJSON_NoKeys_NoLayout a
    -> ReadJSON_NoKeys_NoLayout b -> ReadJSON_NoKeys_NoLayout b)
-> (forall a. a -> ReadJSON_NoKeys_NoLayout a)
-> Monad ReadJSON_NoKeys_NoLayout
forall a. a -> ReadJSON_NoKeys_NoLayout a
forall a b.
ReadJSON_NoKeys_NoLayout a
-> ReadJSON_NoKeys_NoLayout b -> ReadJSON_NoKeys_NoLayout b
forall a b.
ReadJSON_NoKeys_NoLayout a
-> (a -> ReadJSON_NoKeys_NoLayout b) -> ReadJSON_NoKeys_NoLayout b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b.
ReadJSON_NoKeys_NoLayout a
-> (a -> ReadJSON_NoKeys_NoLayout b) -> ReadJSON_NoKeys_NoLayout b
>>= :: forall a b.
ReadJSON_NoKeys_NoLayout a
-> (a -> ReadJSON_NoKeys_NoLayout b) -> ReadJSON_NoKeys_NoLayout b
$c>> :: forall a b.
ReadJSON_NoKeys_NoLayout a
-> ReadJSON_NoKeys_NoLayout b -> ReadJSON_NoKeys_NoLayout b
>> :: forall a b.
ReadJSON_NoKeys_NoLayout a
-> ReadJSON_NoKeys_NoLayout b -> ReadJSON_NoKeys_NoLayout b
$creturn :: forall a. a -> ReadJSON_NoKeys_NoLayout a
return :: forall a. a -> ReadJSON_NoKeys_NoLayout a
Monad
           , MonadError DeserializationError
           )

instance ReportSchemaErrors ReadJSON_Keys_Layout where
  expected :: forall a. String -> Maybe String -> ReadJSON_Keys_Layout a
expected String
str Maybe String
mgot = DeserializationError -> ReadJSON_Keys_Layout a
forall a. DeserializationError -> ReadJSON_Keys_Layout a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DeserializationError -> ReadJSON_Keys_Layout a)
-> DeserializationError -> ReadJSON_Keys_Layout a
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> DeserializationError
expectedError String
str Maybe String
mgot
instance ReportSchemaErrors ReadJSON_Keys_NoLayout where
  expected :: forall a. String -> Maybe String -> ReadJSON_Keys_NoLayout a
expected String
str Maybe String
mgot = DeserializationError -> ReadJSON_Keys_NoLayout a
forall a. DeserializationError -> ReadJSON_Keys_NoLayout a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DeserializationError -> ReadJSON_Keys_NoLayout a)
-> DeserializationError -> ReadJSON_Keys_NoLayout a
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> DeserializationError
expectedError String
str Maybe String
mgot
instance ReportSchemaErrors ReadJSON_NoKeys_NoLayout where
  expected :: forall a. String -> Maybe String -> ReadJSON_NoKeys_NoLayout a
expected String
str Maybe String
mgot = DeserializationError -> ReadJSON_NoKeys_NoLayout a
forall a. DeserializationError -> ReadJSON_NoKeys_NoLayout a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DeserializationError -> ReadJSON_NoKeys_NoLayout a)
-> DeserializationError -> ReadJSON_NoKeys_NoLayout a
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> DeserializationError
expectedError String
str Maybe String
mgot

expectedError :: Expected -> Maybe Got -> DeserializationError
expectedError :: String -> Maybe String -> DeserializationError
expectedError String
str Maybe String
mgot = String -> DeserializationError
DeserializationErrorSchema String
msg
  where
    msg :: String
msg = case Maybe String
mgot of
            Maybe String
Nothing  -> String
"Expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str
            Just String
got -> String
"Expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" but got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
got

instance MonadReader RepoLayout ReadJSON_Keys_Layout where
  ask :: ReadJSON_Keys_Layout RepoLayout
ask         = ExceptT
  DeserializationError (Reader (RepoLayout, KeyEnv)) RepoLayout
-> ReadJSON_Keys_Layout RepoLayout
forall a.
ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
-> ReadJSON_Keys_Layout a
ReadJSON_Keys_Layout (ExceptT
   DeserializationError (Reader (RepoLayout, KeyEnv)) RepoLayout
 -> ReadJSON_Keys_Layout RepoLayout)
-> ExceptT
     DeserializationError (Reader (RepoLayout, KeyEnv)) RepoLayout
-> ReadJSON_Keys_Layout RepoLayout
forall a b. (a -> b) -> a -> b
$ (RepoLayout, KeyEnv) -> RepoLayout
forall a b. (a, b) -> a
fst ((RepoLayout, KeyEnv) -> RepoLayout)
-> ExceptT
     DeserializationError
     (Reader (RepoLayout, KeyEnv))
     (RepoLayout, KeyEnv)
-> ExceptT
     DeserializationError (Reader (RepoLayout, KeyEnv)) RepoLayout
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ExceptT
  DeserializationError
  (Reader (RepoLayout, KeyEnv))
  (RepoLayout, KeyEnv)
forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: forall a.
(RepoLayout -> RepoLayout)
-> ReadJSON_Keys_Layout a -> ReadJSON_Keys_Layout a
local RepoLayout -> RepoLayout
f ReadJSON_Keys_Layout a
act = ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
-> ReadJSON_Keys_Layout a
forall a.
ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
-> ReadJSON_Keys_Layout a
ReadJSON_Keys_Layout (ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
 -> ReadJSON_Keys_Layout a)
-> ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
-> ReadJSON_Keys_Layout a
forall a b. (a -> b) -> a -> b
$ ((RepoLayout, KeyEnv) -> (RepoLayout, KeyEnv))
-> ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
-> ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
forall a.
((RepoLayout, KeyEnv) -> (RepoLayout, KeyEnv))
-> ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
-> ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((RepoLayout -> RepoLayout)
-> (RepoLayout, KeyEnv) -> (RepoLayout, KeyEnv)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first RepoLayout -> RepoLayout
f) ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
act'
    where
      act' :: ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
act' = ReadJSON_Keys_Layout a
-> ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
forall a.
ReadJSON_Keys_Layout a
-> ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
unReadJSON_Keys_Layout ReadJSON_Keys_Layout a
act

instance MonadKeys ReadJSON_Keys_Layout where
  askKeys :: ReadJSON_Keys_Layout KeyEnv
askKeys         = ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) KeyEnv
-> ReadJSON_Keys_Layout KeyEnv
forall a.
ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
-> ReadJSON_Keys_Layout a
ReadJSON_Keys_Layout (ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) KeyEnv
 -> ReadJSON_Keys_Layout KeyEnv)
-> ExceptT
     DeserializationError (Reader (RepoLayout, KeyEnv)) KeyEnv
-> ReadJSON_Keys_Layout KeyEnv
forall a b. (a -> b) -> a -> b
$ (RepoLayout, KeyEnv) -> KeyEnv
forall a b. (a, b) -> b
snd ((RepoLayout, KeyEnv) -> KeyEnv)
-> ExceptT
     DeserializationError
     (Reader (RepoLayout, KeyEnv))
     (RepoLayout, KeyEnv)
-> ExceptT
     DeserializationError (Reader (RepoLayout, KeyEnv)) KeyEnv
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ExceptT
  DeserializationError
  (Reader (RepoLayout, KeyEnv))
  (RepoLayout, KeyEnv)
forall r (m :: * -> *). MonadReader r m => m r
ask
  localKeys :: forall a.
(KeyEnv -> KeyEnv)
-> ReadJSON_Keys_Layout a -> ReadJSON_Keys_Layout a
localKeys KeyEnv -> KeyEnv
f ReadJSON_Keys_Layout a
act = ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
-> ReadJSON_Keys_Layout a
forall a.
ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
-> ReadJSON_Keys_Layout a
ReadJSON_Keys_Layout (ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
 -> ReadJSON_Keys_Layout a)
-> ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
-> ReadJSON_Keys_Layout a
forall a b. (a -> b) -> a -> b
$ ((RepoLayout, KeyEnv) -> (RepoLayout, KeyEnv))
-> ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
-> ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
forall a.
((RepoLayout, KeyEnv) -> (RepoLayout, KeyEnv))
-> ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
-> ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((KeyEnv -> KeyEnv) -> (RepoLayout, KeyEnv) -> (RepoLayout, KeyEnv)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second KeyEnv -> KeyEnv
f) ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
act'
    where
      act' :: ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
act' = ReadJSON_Keys_Layout a
-> ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
forall a.
ReadJSON_Keys_Layout a
-> ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
unReadJSON_Keys_Layout ReadJSON_Keys_Layout a
act

instance MonadKeys ReadJSON_Keys_NoLayout where
  askKeys :: ReadJSON_Keys_NoLayout KeyEnv
askKeys         = ExceptT DeserializationError (Reader KeyEnv) KeyEnv
-> ReadJSON_Keys_NoLayout KeyEnv
forall a.
ExceptT DeserializationError (Reader KeyEnv) a
-> ReadJSON_Keys_NoLayout a
ReadJSON_Keys_NoLayout (ExceptT DeserializationError (Reader KeyEnv) KeyEnv
 -> ReadJSON_Keys_NoLayout KeyEnv)
-> ExceptT DeserializationError (Reader KeyEnv) KeyEnv
-> ReadJSON_Keys_NoLayout KeyEnv
forall a b. (a -> b) -> a -> b
$ ExceptT DeserializationError (Reader KeyEnv) KeyEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
  localKeys :: forall a.
(KeyEnv -> KeyEnv)
-> ReadJSON_Keys_NoLayout a -> ReadJSON_Keys_NoLayout a
localKeys KeyEnv -> KeyEnv
f ReadJSON_Keys_NoLayout a
act = ExceptT DeserializationError (Reader KeyEnv) a
-> ReadJSON_Keys_NoLayout a
forall a.
ExceptT DeserializationError (Reader KeyEnv) a
-> ReadJSON_Keys_NoLayout a
ReadJSON_Keys_NoLayout (ExceptT DeserializationError (Reader KeyEnv) a
 -> ReadJSON_Keys_NoLayout a)
-> ExceptT DeserializationError (Reader KeyEnv) a
-> ReadJSON_Keys_NoLayout a
forall a b. (a -> b) -> a -> b
$ (KeyEnv -> KeyEnv)
-> ExceptT DeserializationError (Reader KeyEnv) a
-> ExceptT DeserializationError (Reader KeyEnv) a
forall a.
(KeyEnv -> KeyEnv)
-> ExceptT DeserializationError (Reader KeyEnv) a
-> ExceptT DeserializationError (Reader KeyEnv) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local KeyEnv -> KeyEnv
f ExceptT DeserializationError (Reader KeyEnv) a
act'
    where
      act' :: ExceptT DeserializationError (Reader KeyEnv) a
act' = ReadJSON_Keys_NoLayout a
-> ExceptT DeserializationError (Reader KeyEnv) a
forall a.
ReadJSON_Keys_NoLayout a
-> ExceptT DeserializationError (Reader KeyEnv) a
unReadJSON_Keys_NoLayout ReadJSON_Keys_NoLayout a
act

runReadJSON_Keys_Layout :: KeyEnv
                        -> RepoLayout
                        -> ReadJSON_Keys_Layout a
                        -> Either DeserializationError a
runReadJSON_Keys_Layout :: forall a.
KeyEnv
-> RepoLayout
-> ReadJSON_Keys_Layout a
-> Either DeserializationError a
runReadJSON_Keys_Layout KeyEnv
keyEnv RepoLayout
repoLayout ReadJSON_Keys_Layout a
act =
    Reader (RepoLayout, KeyEnv) (Either DeserializationError a)
-> (RepoLayout, KeyEnv) -> Either DeserializationError a
forall r a. Reader r a -> r -> a
runReader (ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
-> Reader (RepoLayout, KeyEnv) (Either DeserializationError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ReadJSON_Keys_Layout a
-> ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
forall a.
ReadJSON_Keys_Layout a
-> ExceptT DeserializationError (Reader (RepoLayout, KeyEnv)) a
unReadJSON_Keys_Layout ReadJSON_Keys_Layout a
act)) (RepoLayout
repoLayout, KeyEnv
keyEnv)

runReadJSON_Keys_NoLayout :: KeyEnv
                          -> ReadJSON_Keys_NoLayout a
                          -> Either DeserializationError a
runReadJSON_Keys_NoLayout :: forall a.
KeyEnv -> ReadJSON_Keys_NoLayout a -> Either DeserializationError a
runReadJSON_Keys_NoLayout KeyEnv
keyEnv ReadJSON_Keys_NoLayout a
act =
    Reader KeyEnv (Either DeserializationError a)
-> KeyEnv -> Either DeserializationError a
forall r a. Reader r a -> r -> a
runReader (ExceptT DeserializationError (Reader KeyEnv) a
-> Reader KeyEnv (Either DeserializationError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ReadJSON_Keys_NoLayout a
-> ExceptT DeserializationError (Reader KeyEnv) a
forall a.
ReadJSON_Keys_NoLayout a
-> ExceptT DeserializationError (Reader KeyEnv) a
unReadJSON_Keys_NoLayout ReadJSON_Keys_NoLayout a
act)) KeyEnv
keyEnv

runReadJSON_NoKeys_NoLayout :: ReadJSON_NoKeys_NoLayout a
                            -> Either DeserializationError a
runReadJSON_NoKeys_NoLayout :: forall a.
ReadJSON_NoKeys_NoLayout a -> Either DeserializationError a
runReadJSON_NoKeys_NoLayout ReadJSON_NoKeys_NoLayout a
act =
    Except DeserializationError a -> Either DeserializationError a
forall e a. Except e a -> Either e a
runExcept (ReadJSON_NoKeys_NoLayout a -> Except DeserializationError a
forall a.
ReadJSON_NoKeys_NoLayout a -> Except DeserializationError a
unReadJSON_NoKeys_NoLayout ReadJSON_NoKeys_NoLayout a
act)

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

parseJSON_Keys_Layout :: FromJSON ReadJSON_Keys_Layout a
                      => KeyEnv
                      -> RepoLayout
                      -> BS.L.ByteString
                      -> Either DeserializationError a
parseJSON_Keys_Layout :: forall a.
FromJSON ReadJSON_Keys_Layout a =>
KeyEnv -> RepoLayout -> ByteString -> Either DeserializationError a
parseJSON_Keys_Layout KeyEnv
keyEnv RepoLayout
repoLayout ByteString
bs =
    case ByteString -> Either String JSValue
parseCanonicalJSON ByteString
bs of
      Left  String
err -> DeserializationError -> Either DeserializationError a
forall a b. a -> Either a b
Left (String -> DeserializationError
DeserializationErrorMalformed String
err)
      Right JSValue
val -> KeyEnv
-> RepoLayout
-> ReadJSON_Keys_Layout a
-> Either DeserializationError a
forall a.
KeyEnv
-> RepoLayout
-> ReadJSON_Keys_Layout a
-> Either DeserializationError a
runReadJSON_Keys_Layout KeyEnv
keyEnv RepoLayout
repoLayout (JSValue -> ReadJSON_Keys_Layout a
forall (m :: * -> *) a. FromJSON m a => JSValue -> m a
fromJSON JSValue
val)

parseJSON_Keys_NoLayout :: FromJSON ReadJSON_Keys_NoLayout a
                        => KeyEnv
                        -> BS.L.ByteString
                        -> Either DeserializationError a
parseJSON_Keys_NoLayout :: forall a.
FromJSON ReadJSON_Keys_NoLayout a =>
KeyEnv -> ByteString -> Either DeserializationError a
parseJSON_Keys_NoLayout KeyEnv
keyEnv ByteString
bs =
    case ByteString -> Either String JSValue
parseCanonicalJSON ByteString
bs of
      Left  String
err -> DeserializationError -> Either DeserializationError a
forall a b. a -> Either a b
Left (String -> DeserializationError
DeserializationErrorMalformed String
err)
      Right JSValue
val -> KeyEnv -> ReadJSON_Keys_NoLayout a -> Either DeserializationError a
forall a.
KeyEnv -> ReadJSON_Keys_NoLayout a -> Either DeserializationError a
runReadJSON_Keys_NoLayout KeyEnv
keyEnv (JSValue -> ReadJSON_Keys_NoLayout a
forall (m :: * -> *) a. FromJSON m a => JSValue -> m a
fromJSON JSValue
val)

parseJSON_NoKeys_NoLayout :: FromJSON ReadJSON_NoKeys_NoLayout a
                          => BS.L.ByteString
                          -> Either DeserializationError a
parseJSON_NoKeys_NoLayout :: forall a.
FromJSON ReadJSON_NoKeys_NoLayout a =>
ByteString -> Either DeserializationError a
parseJSON_NoKeys_NoLayout ByteString
bs =
    case ByteString -> Either String JSValue
parseCanonicalJSON ByteString
bs of
      Left  String
err -> DeserializationError -> Either DeserializationError a
forall a b. a -> Either a b
Left (String -> DeserializationError
DeserializationErrorMalformed String
err)
      Right JSValue
val -> ReadJSON_NoKeys_NoLayout a -> Either DeserializationError a
forall a.
ReadJSON_NoKeys_NoLayout a -> Either DeserializationError a
runReadJSON_NoKeys_NoLayout (JSValue -> ReadJSON_NoKeys_NoLayout a
forall (m :: * -> *) a. FromJSON m a => JSValue -> m a
fromJSON JSValue
val)

readJSON_Keys_Layout :: ( FsRoot root
                        , FromJSON ReadJSON_Keys_Layout a
                        )
                     => KeyEnv
                     -> RepoLayout
                     -> Path root
                     -> IO (Either DeserializationError a)
readJSON_Keys_Layout :: forall root a.
(FsRoot root, FromJSON ReadJSON_Keys_Layout a) =>
KeyEnv
-> RepoLayout -> Path root -> IO (Either DeserializationError a)
readJSON_Keys_Layout KeyEnv
keyEnv RepoLayout
repoLayout Path root
fp = do
    Path root
-> IOMode
-> (Handle -> IO (Either DeserializationError a))
-> IO (Either DeserializationError a)
forall root r.
FsRoot root =>
Path root -> IOMode -> (Handle -> IO r) -> IO r
withFile Path root
fp IOMode
ReadMode ((Handle -> IO (Either DeserializationError a))
 -> IO (Either DeserializationError a))
-> (Handle -> IO (Either DeserializationError a))
-> IO (Either DeserializationError a)
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
      ByteString
bs <- Handle -> IO ByteString
BS.L.hGetContents Handle
h
      Either DeserializationError a -> IO (Either DeserializationError a)
forall a. a -> IO a
evaluate (Either DeserializationError a
 -> IO (Either DeserializationError a))
-> Either DeserializationError a
-> IO (Either DeserializationError a)
forall a b. (a -> b) -> a -> b
$ KeyEnv -> RepoLayout -> ByteString -> Either DeserializationError a
forall a.
FromJSON ReadJSON_Keys_Layout a =>
KeyEnv -> RepoLayout -> ByteString -> Either DeserializationError a
parseJSON_Keys_Layout KeyEnv
keyEnv RepoLayout
repoLayout ByteString
bs

readJSON_Keys_NoLayout :: ( FsRoot root
                          , FromJSON ReadJSON_Keys_NoLayout a
                          )
                       => KeyEnv
                       -> Path root
                       -> IO (Either DeserializationError a)
readJSON_Keys_NoLayout :: forall root a.
(FsRoot root, FromJSON ReadJSON_Keys_NoLayout a) =>
KeyEnv -> Path root -> IO (Either DeserializationError a)
readJSON_Keys_NoLayout KeyEnv
keyEnv Path root
fp = do
    Path root
-> IOMode
-> (Handle -> IO (Either DeserializationError a))
-> IO (Either DeserializationError a)
forall root r.
FsRoot root =>
Path root -> IOMode -> (Handle -> IO r) -> IO r
withFile Path root
fp IOMode
ReadMode ((Handle -> IO (Either DeserializationError a))
 -> IO (Either DeserializationError a))
-> (Handle -> IO (Either DeserializationError a))
-> IO (Either DeserializationError a)
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
      ByteString
bs <- Handle -> IO ByteString
BS.L.hGetContents Handle
h
      Either DeserializationError a -> IO (Either DeserializationError a)
forall a. a -> IO a
evaluate (Either DeserializationError a
 -> IO (Either DeserializationError a))
-> Either DeserializationError a
-> IO (Either DeserializationError a)
forall a b. (a -> b) -> a -> b
$ KeyEnv -> ByteString -> Either DeserializationError a
forall a.
FromJSON ReadJSON_Keys_NoLayout a =>
KeyEnv -> ByteString -> Either DeserializationError a
parseJSON_Keys_NoLayout KeyEnv
keyEnv ByteString
bs

readJSON_NoKeys_NoLayout :: ( FsRoot root
                            , FromJSON ReadJSON_NoKeys_NoLayout a
                            )
                         => Path root
                         -> IO (Either DeserializationError a)
readJSON_NoKeys_NoLayout :: forall root a.
(FsRoot root, FromJSON ReadJSON_NoKeys_NoLayout a) =>
Path root -> IO (Either DeserializationError a)
readJSON_NoKeys_NoLayout Path root
fp = do
    Path root
-> IOMode
-> (Handle -> IO (Either DeserializationError a))
-> IO (Either DeserializationError a)
forall root r.
FsRoot root =>
Path root -> IOMode -> (Handle -> IO r) -> IO r
withFile Path root
fp IOMode
ReadMode ((Handle -> IO (Either DeserializationError a))
 -> IO (Either DeserializationError a))
-> (Handle -> IO (Either DeserializationError a))
-> IO (Either DeserializationError a)
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
      ByteString
bs <- Handle -> IO ByteString
BS.L.hGetContents Handle
h
      Either DeserializationError a -> IO (Either DeserializationError a)
forall a. a -> IO a
evaluate (Either DeserializationError a
 -> IO (Either DeserializationError a))
-> Either DeserializationError a
-> IO (Either DeserializationError a)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either DeserializationError a
forall a.
FromJSON ReadJSON_NoKeys_NoLayout a =>
ByteString -> Either DeserializationError a
parseJSON_NoKeys_NoLayout ByteString
bs

{-------------------------------------------------------------------------------
  Writing
-------------------------------------------------------------------------------}

newtype WriteJSON a = WriteJSON {
    forall a. WriteJSON a -> Reader RepoLayout a
unWriteJSON :: Reader RepoLayout a
  }
  deriving ( (forall a b. (a -> b) -> WriteJSON a -> WriteJSON b)
-> (forall a b. a -> WriteJSON b -> WriteJSON a)
-> Functor WriteJSON
forall a b. a -> WriteJSON b -> WriteJSON a
forall a b. (a -> b) -> WriteJSON a -> WriteJSON b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> WriteJSON a -> WriteJSON b
fmap :: forall a b. (a -> b) -> WriteJSON a -> WriteJSON b
$c<$ :: forall a b. a -> WriteJSON b -> WriteJSON a
<$ :: forall a b. a -> WriteJSON b -> WriteJSON a
Functor
           , Functor WriteJSON
Functor WriteJSON =>
(forall a. a -> WriteJSON a)
-> (forall a b. WriteJSON (a -> b) -> WriteJSON a -> WriteJSON b)
-> (forall a b c.
    (a -> b -> c) -> WriteJSON a -> WriteJSON b -> WriteJSON c)
-> (forall a b. WriteJSON a -> WriteJSON b -> WriteJSON b)
-> (forall a b. WriteJSON a -> WriteJSON b -> WriteJSON a)
-> Applicative WriteJSON
forall a. a -> WriteJSON a
forall a b. WriteJSON a -> WriteJSON b -> WriteJSON a
forall a b. WriteJSON a -> WriteJSON b -> WriteJSON b
forall a b. WriteJSON (a -> b) -> WriteJSON a -> WriteJSON b
forall a b c.
(a -> b -> c) -> WriteJSON a -> WriteJSON b -> WriteJSON c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> WriteJSON a
pure :: forall a. a -> WriteJSON a
$c<*> :: forall a b. WriteJSON (a -> b) -> WriteJSON a -> WriteJSON b
<*> :: forall a b. WriteJSON (a -> b) -> WriteJSON a -> WriteJSON b
$cliftA2 :: forall a b c.
(a -> b -> c) -> WriteJSON a -> WriteJSON b -> WriteJSON c
liftA2 :: forall a b c.
(a -> b -> c) -> WriteJSON a -> WriteJSON b -> WriteJSON c
$c*> :: forall a b. WriteJSON a -> WriteJSON b -> WriteJSON b
*> :: forall a b. WriteJSON a -> WriteJSON b -> WriteJSON b
$c<* :: forall a b. WriteJSON a -> WriteJSON b -> WriteJSON a
<* :: forall a b. WriteJSON a -> WriteJSON b -> WriteJSON a
Applicative
           , Applicative WriteJSON
Applicative WriteJSON =>
(forall a b. WriteJSON a -> (a -> WriteJSON b) -> WriteJSON b)
-> (forall a b. WriteJSON a -> WriteJSON b -> WriteJSON b)
-> (forall a. a -> WriteJSON a)
-> Monad WriteJSON
forall a. a -> WriteJSON a
forall a b. WriteJSON a -> WriteJSON b -> WriteJSON b
forall a b. WriteJSON a -> (a -> WriteJSON b) -> WriteJSON b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. WriteJSON a -> (a -> WriteJSON b) -> WriteJSON b
>>= :: forall a b. WriteJSON a -> (a -> WriteJSON b) -> WriteJSON b
$c>> :: forall a b. WriteJSON a -> WriteJSON b -> WriteJSON b
>> :: forall a b. WriteJSON a -> WriteJSON b -> WriteJSON b
$creturn :: forall a. a -> WriteJSON a
return :: forall a. a -> WriteJSON a
Monad
           , MonadReader RepoLayout
           )

runWriteJSON :: RepoLayout -> WriteJSON a -> a
runWriteJSON :: forall a. RepoLayout -> WriteJSON a -> a
runWriteJSON RepoLayout
repoLayout WriteJSON a
act = Reader RepoLayout a -> RepoLayout -> a
forall r a. Reader r a -> r -> a
runReader (WriteJSON a -> Reader RepoLayout a
forall a. WriteJSON a -> Reader RepoLayout a
unWriteJSON WriteJSON a
act) RepoLayout
repoLayout

{-------------------------------------------------------------------------------
  Writing: Utility
-------------------------------------------------------------------------------}

-- | Render to canonical JSON format
renderJSON :: ToJSON WriteJSON a => RepoLayout -> a -> BS.L.ByteString
renderJSON :: forall a. ToJSON WriteJSON a => RepoLayout -> a -> ByteString
renderJSON RepoLayout
repoLayout = JSValue -> ByteString
renderCanonicalJSON (JSValue -> ByteString) -> (a -> JSValue) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepoLayout -> WriteJSON JSValue -> JSValue
forall a. RepoLayout -> WriteJSON a -> a
runWriteJSON RepoLayout
repoLayout (WriteJSON JSValue -> JSValue)
-> (a -> WriteJSON JSValue) -> a -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> WriteJSON JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON

-- | Variation on 'renderJSON' for files that don't require the repo layout
renderJSON_NoLayout :: ToJSON Identity a => a -> BS.L.ByteString
renderJSON_NoLayout :: forall a. ToJSON Identity a => a -> ByteString
renderJSON_NoLayout = JSValue -> ByteString
renderCanonicalJSON (JSValue -> ByteString) -> (a -> JSValue) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity JSValue -> JSValue
forall a. Identity a -> a
runIdentity (Identity JSValue -> JSValue)
-> (a -> Identity JSValue) -> a -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON

writeJSON :: ToJSON WriteJSON a => RepoLayout -> Path Absolute -> a -> IO ()
writeJSON :: forall a.
ToJSON WriteJSON a =>
RepoLayout -> Path Absolute -> a -> IO ()
writeJSON RepoLayout
repoLayout Path Absolute
fp = Path Absolute -> ByteString -> IO ()
forall root. FsRoot root => Path root -> ByteString -> IO ()
writeLazyByteString Path Absolute
fp (ByteString -> IO ()) -> (a -> ByteString) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepoLayout -> a -> ByteString
forall a. ToJSON WriteJSON a => RepoLayout -> a -> ByteString
renderJSON RepoLayout
repoLayout

writeJSON_NoLayout :: ToJSON Identity a => Path Absolute -> a -> IO ()
writeJSON_NoLayout :: forall a. ToJSON Identity a => Path Absolute -> a -> IO ()
writeJSON_NoLayout Path Absolute
fp = Path Absolute -> ByteString -> IO ()
forall root. FsRoot root => Path root -> ByteString -> IO ()
writeLazyByteString Path Absolute
fp (ByteString -> IO ()) -> (a -> ByteString) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON Identity a => a -> ByteString
renderJSON_NoLayout

writeKeyAsId :: Some PublicKey -> JSValue
writeKeyAsId :: Some PublicKey -> JSValue
writeKeyAsId = String -> JSValue
JSString (String -> JSValue)
-> (Some PublicKey -> String) -> Some PublicKey -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyId -> String
keyIdString (KeyId -> String)
-> (Some PublicKey -> KeyId) -> Some PublicKey -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Some PublicKey -> KeyId
forall (key :: * -> *). HasKeyId key => Some key -> KeyId
someKeyId