{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-|
Description : JSON serialization

This module is mostly a stub for now
providing (From|To)JSON for Realisation type
which is required for `-remote`.
-}
module System.Nix.JSON where

import Data.Aeson
import Deriving.Aeson
import System.Nix.Base (BaseEncoding(NixBase32))
import System.Nix.OutputName (OutputName)
import System.Nix.Realisation (DerivationOutput, Realisation, RealisationWithId(..))
import System.Nix.Signature (Signature)
import System.Nix.StorePath (StoreDir(..), StorePath, StorePathName, StorePathHashPart)

import qualified Data.Aeson.KeyMap
import qualified Data.Aeson.Types
import qualified Data.Attoparsec.Text
import qualified Data.Char
import qualified Data.Text
import qualified Data.Text.Lazy
import qualified Data.Text.Lazy.Builder
import qualified System.Nix.Base
import qualified System.Nix.OutputName
import qualified System.Nix.Realisation
import qualified System.Nix.Signature
import qualified System.Nix.StorePath

instance ToJSON StorePathName where
  toJSON :: StorePathName -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (StorePathName -> Text) -> StorePathName -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePathName -> Text
System.Nix.StorePath.unStorePathName
  toEncoding :: StorePathName -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Encoding)
-> (StorePathName -> Text) -> StorePathName -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePathName -> Text
System.Nix.StorePath.unStorePathName

instance FromJSON StorePathName where
  parseJSON :: Value -> Parser StorePathName
parseJSON =
    String
-> (Text -> Parser StorePathName) -> Value -> Parser StorePathName
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"StorePathName"
    ( (InvalidNameError -> Parser StorePathName)
-> (StorePathName -> Parser StorePathName)
-> Either InvalidNameError StorePathName
-> Parser StorePathName
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser StorePathName
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser StorePathName)
-> (InvalidNameError -> String)
-> InvalidNameError
-> Parser StorePathName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InvalidNameError -> String
forall a. Show a => a -> String
show) StorePathName -> Parser StorePathName
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Either InvalidNameError StorePathName -> Parser StorePathName)
-> (Text -> Either InvalidNameError StorePathName)
-> Text
-> Parser StorePathName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either InvalidNameError StorePathName
System.Nix.StorePath.mkStorePathName)

instance ToJSON StorePathHashPart where
  toJSON :: StorePathHashPart -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (StorePathHashPart -> Text) -> StorePathHashPart -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePathHashPart -> Text
System.Nix.StorePath.storePathHashPartToText
  toEncoding :: StorePathHashPart -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Encoding)
-> (StorePathHashPart -> Text) -> StorePathHashPart -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePathHashPart -> Text
System.Nix.StorePath.storePathHashPartToText

instance FromJSON StorePathHashPart where
  parseJSON :: Value -> Parser StorePathHashPart
parseJSON =
    String
-> (Text -> Parser StorePathHashPart)
-> Value
-> Parser StorePathHashPart
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"StorePathHashPart"
    ( (String -> Parser StorePathHashPart)
-> (ByteString -> Parser StorePathHashPart)
-> Either String ByteString
-> Parser StorePathHashPart
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (String -> Parser StorePathHashPart
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser StorePathHashPart)
-> (String -> String) -> String -> Parser StorePathHashPart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show)
        (StorePathHashPart -> Parser StorePathHashPart
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StorePathHashPart -> Parser StorePathHashPart)
-> (ByteString -> StorePathHashPart)
-> ByteString
-> Parser StorePathHashPart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> StorePathHashPart
System.Nix.StorePath.unsafeMakeStorePathHashPart)
    (Either String ByteString -> Parser StorePathHashPart)
-> (Text -> Either String ByteString)
-> Text
-> Parser StorePathHashPart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseEncoding -> Text -> Either String ByteString
System.Nix.Base.decodeWith BaseEncoding
NixBase32
    )

instance ToJSON StorePath where
  toJSON :: StorePath -> Value
toJSON =
    Text -> Value
forall a. ToJSON a => a -> Value
toJSON
    -- TODO: hacky, we need to stop requiring StoreDir for
    -- StorePath rendering and have a distinct
    -- types for rooted|unrooted paths
    (Text -> Value) -> (StorePath -> Text) -> StorePath -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Data.Text.drop Int
1
    (Text -> Text) -> (StorePath -> Text) -> StorePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreDir -> StorePath -> Text
System.Nix.StorePath.storePathToText (ByteString -> StoreDir
StoreDir ByteString
forall a. Monoid a => a
mempty)

  toEncoding :: StorePath -> Encoding
toEncoding =
    Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding
    (Text -> Encoding) -> (StorePath -> Text) -> StorePath -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Data.Text.drop Int
1
    (Text -> Text) -> (StorePath -> Text) -> StorePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreDir -> StorePath -> Text
System.Nix.StorePath.storePathToText (ByteString -> StoreDir
StoreDir ByteString
forall a. Monoid a => a
mempty)

instance FromJSON StorePath where
  parseJSON :: Value -> Parser StorePath
parseJSON =
    String -> (Text -> Parser StorePath) -> Value -> Parser StorePath
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"StorePath"
    ( (InvalidPathError -> Parser StorePath)
-> (StorePath -> Parser StorePath)
-> Either InvalidPathError StorePath
-> Parser StorePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (String -> Parser StorePath
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser StorePath)
-> (InvalidPathError -> String)
-> InvalidPathError
-> Parser StorePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InvalidPathError -> String
forall a. Show a => a -> String
show)
        StorePath -> Parser StorePath
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Either InvalidPathError StorePath -> Parser StorePath)
-> (Text -> Either InvalidPathError StorePath)
-> Text
-> Parser StorePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreDir -> Text -> Either InvalidPathError StorePath
System.Nix.StorePath.parsePathFromText (ByteString -> StoreDir
StoreDir ByteString
forall a. Monoid a => a
mempty)
    (Text -> Either InvalidPathError StorePath)
-> (Text -> Text) -> Text -> Either InvalidPathError StorePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
Data.Text.cons Char
'/'
    )

instance ToJSON (DerivationOutput OutputName) where
  toJSON :: DerivationOutput OutputName -> Value
toJSON =
    Text -> Value
forall a. ToJSON a => a -> Value
toJSON
    (Text -> Value)
-> (DerivationOutput OutputName -> Text)
-> DerivationOutput OutputName
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Data.Text.Lazy.toStrict
    (Text -> Text)
-> (DerivationOutput OutputName -> Text)
-> DerivationOutput OutputName
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Data.Text.Lazy.Builder.toLazyText
    (Builder -> Text)
-> (DerivationOutput OutputName -> Builder)
-> DerivationOutput OutputName
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OutputName -> Text) -> DerivationOutput OutputName -> Builder
forall outputName.
(outputName -> Text) -> DerivationOutput outputName -> Builder
System.Nix.Realisation.derivationOutputBuilder
        OutputName -> Text
System.Nix.OutputName.unOutputName

  toEncoding :: DerivationOutput OutputName -> Encoding
toEncoding =
    Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding
    (Text -> Encoding)
-> (DerivationOutput OutputName -> Text)
-> DerivationOutput OutputName
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Data.Text.Lazy.toStrict
    (Text -> Text)
-> (DerivationOutput OutputName -> Text)
-> DerivationOutput OutputName
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Data.Text.Lazy.Builder.toLazyText
    (Builder -> Text)
-> (DerivationOutput OutputName -> Builder)
-> DerivationOutput OutputName
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OutputName -> Text) -> DerivationOutput OutputName -> Builder
forall outputName.
(outputName -> Text) -> DerivationOutput outputName -> Builder
System.Nix.Realisation.derivationOutputBuilder
        OutputName -> Text
System.Nix.OutputName.unOutputName

instance ToJSONKey (DerivationOutput OutputName) where
  toJSONKey :: ToJSONKeyFunction (DerivationOutput OutputName)
toJSONKey =
    (DerivationOutput OutputName -> Text)
-> ToJSONKeyFunction (DerivationOutput OutputName)
forall a. (a -> Text) -> ToJSONKeyFunction a
Data.Aeson.Types.toJSONKeyText
    ((DerivationOutput OutputName -> Text)
 -> ToJSONKeyFunction (DerivationOutput OutputName))
-> (DerivationOutput OutputName -> Text)
-> ToJSONKeyFunction (DerivationOutput OutputName)
forall a b. (a -> b) -> a -> b
$ Text -> Text
Data.Text.Lazy.toStrict
    (Text -> Text)
-> (DerivationOutput OutputName -> Text)
-> DerivationOutput OutputName
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Data.Text.Lazy.Builder.toLazyText
    (Builder -> Text)
-> (DerivationOutput OutputName -> Builder)
-> DerivationOutput OutputName
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OutputName -> Text) -> DerivationOutput OutputName -> Builder
forall outputName.
(outputName -> Text) -> DerivationOutput outputName -> Builder
System.Nix.Realisation.derivationOutputBuilder
        OutputName -> Text
System.Nix.OutputName.unOutputName

instance FromJSON (DerivationOutput OutputName) where
  parseJSON :: Value -> Parser (DerivationOutput OutputName)
parseJSON =
    String
-> (Text -> Parser (DerivationOutput OutputName))
-> Value
-> Parser (DerivationOutput OutputName)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"DerivationOutput OutputName"
    ( (DerivationOutputError -> Parser (DerivationOutput OutputName))
-> (DerivationOutput OutputName
    -> Parser (DerivationOutput OutputName))
-> Either DerivationOutputError (DerivationOutput OutputName)
-> Parser (DerivationOutput OutputName)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (String -> Parser (DerivationOutput OutputName)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (DerivationOutput OutputName))
-> (DerivationOutputError -> String)
-> DerivationOutputError
-> Parser (DerivationOutput OutputName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivationOutputError -> String
forall a. Show a => a -> String
show)
        DerivationOutput OutputName -> Parser (DerivationOutput OutputName)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Either DerivationOutputError (DerivationOutput OutputName)
 -> Parser (DerivationOutput OutputName))
-> (Text
    -> Either DerivationOutputError (DerivationOutput OutputName))
-> Text
-> Parser (DerivationOutput OutputName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either InvalidNameError OutputName)
-> Text
-> Either DerivationOutputError (DerivationOutput OutputName)
forall outputName.
(Text -> Either InvalidNameError outputName)
-> Text
-> Either DerivationOutputError (DerivationOutput outputName)
System.Nix.Realisation.derivationOutputParser
        Text -> Either InvalidNameError OutputName
System.Nix.OutputName.mkOutputName
    )

instance FromJSONKey (DerivationOutput OutputName) where
  fromJSONKey :: FromJSONKeyFunction (DerivationOutput OutputName)
fromJSONKey =
    (Text -> Parser (DerivationOutput OutputName))
-> FromJSONKeyFunction (DerivationOutput OutputName)
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser
    ( (DerivationOutputError -> Parser (DerivationOutput OutputName))
-> (DerivationOutput OutputName
    -> Parser (DerivationOutput OutputName))
-> Either DerivationOutputError (DerivationOutput OutputName)
-> Parser (DerivationOutput OutputName)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (String -> Parser (DerivationOutput OutputName)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (DerivationOutput OutputName))
-> (DerivationOutputError -> String)
-> DerivationOutputError
-> Parser (DerivationOutput OutputName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivationOutputError -> String
forall a. Show a => a -> String
show)
        DerivationOutput OutputName -> Parser (DerivationOutput OutputName)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Either DerivationOutputError (DerivationOutput OutputName)
 -> Parser (DerivationOutput OutputName))
-> (Text
    -> Either DerivationOutputError (DerivationOutput OutputName))
-> Text
-> Parser (DerivationOutput OutputName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either InvalidNameError OutputName)
-> Text
-> Either DerivationOutputError (DerivationOutput OutputName)
forall outputName.
(Text -> Either InvalidNameError outputName)
-> Text
-> Either DerivationOutputError (DerivationOutput outputName)
System.Nix.Realisation.derivationOutputParser
        Text -> Either InvalidNameError OutputName
System.Nix.OutputName.mkOutputName
    )

instance ToJSON Signature where
  toJSON :: Signature -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Signature -> Text) -> Signature -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Text
System.Nix.Signature.signatureToText
  toEncoding :: Signature -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Encoding) -> (Signature -> Text) -> Signature -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Text
System.Nix.Signature.signatureToText

instance FromJSON Signature where
  parseJSON :: Value -> Parser Signature
parseJSON =
    String -> (Text -> Parser Signature) -> Value -> Parser Signature
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Signature"
    ( (String -> Parser Signature)
-> (Signature -> Parser Signature)
-> Either String Signature
-> Parser Signature
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (String -> Parser Signature
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Signature)
-> (String -> String) -> String -> Parser Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show)
        Signature -> Parser Signature
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Either String Signature -> Parser Signature)
-> (Text -> Either String Signature) -> Text -> Parser Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Signature -> Text -> Either String Signature
forall a. Parser a -> Text -> Either String a
Data.Attoparsec.Text.parseOnly
        Parser Signature
System.Nix.Signature.signatureParser
    )

data LowerLeading
instance StringModifier LowerLeading where
  getStringModifier :: String -> String
getStringModifier String
"" = String
""
  getStringModifier (Char
c:String
xs) = Char -> Char
Data.Char.toLower Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs

deriving
  via CustomJSON
    '[FieldLabelModifier
       '[ StripPrefix "realisation"
        , LowerLeading
        , Rename "dependencies" "dependentRealisations"
        ]
     ] Realisation
  instance ToJSON Realisation
deriving
  via CustomJSON
    '[FieldLabelModifier
       '[ StripPrefix "realisation"
        , LowerLeading
        , Rename "dependencies" "dependentRealisations"
        ]
     ] Realisation
  instance FromJSON Realisation

-- For a keyed version of Realisation
-- we use RealisationWithId (DerivationOutput OutputName, Realisation)
-- instead of Realisation.id :: (DerivationOutput OutputName)
-- field.
instance ToJSON RealisationWithId where
  toJSON :: RealisationWithId -> Value
toJSON (RealisationWithId (DerivationOutput OutputName
drvOut, Realisation
r)) =
    case Realisation -> Value
forall a. ToJSON a => a -> Value
toJSON Realisation
r of
      Object Object
o -> Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
Data.Aeson.KeyMap.insert Key
"id" (DerivationOutput OutputName -> Value
forall a. ToJSON a => a -> Value
toJSON DerivationOutput OutputName
drvOut) Object
o
      Value
_ -> String -> Value
forall a. HasCallStack => String -> a
error String
"absurd"

instance FromJSON RealisationWithId where
  parseJSON :: Value -> Parser RealisationWithId
parseJSON v :: Value
v@(Object Object
o) = do
    Realisation
r <- forall a. FromJSON a => Value -> Parser a
parseJSON @Realisation Value
v
    DerivationOutput OutputName
drvOut <- Object
o Object -> Key -> Parser (DerivationOutput OutputName)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    RealisationWithId -> Parser RealisationWithId
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((DerivationOutput OutputName, Realisation) -> RealisationWithId
RealisationWithId (DerivationOutput OutputName
drvOut, Realisation
r))
  parseJSON Value
x = String -> Parser RealisationWithId
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser RealisationWithId)
-> String -> Parser RealisationWithId
forall a b. (a -> b) -> a -> b
$ String
"Expected Object but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
x