{-# LANGUAGE OverloadedStrings #-}

module System.Nix.ContentAddress (
    ContentAddress
  , ContentAddressMethod
  , FileIngestionMethod
  , contentAddressBuilder
  , contentAddressParser
  , buildContentAddress
  , parseContentAddress
  ) where

import Control.Applicative
import Crypto.Hash (Digest)
import Data.Attoparsec.Text (Parser)
import Data.Dependent.Sum (DSum)
import Data.Text (Text)
import Data.Text.Lazy.Builder (Builder)
import GHC.Generics (Generic)
import System.Nix.Hash (HashAlgo)
import System.Nix.Store.Types (FileIngestionMethod(..))

import qualified Data.Attoparsec.Text
import qualified Data.Text.Lazy
import qualified Data.Text.Lazy.Builder
import qualified System.Nix.Hash

data ContentAddressMethod
  = FileIngestionMethod !FileIngestionMethod
  -- ^ The path was added to the store via makeFixedOutputPath or
  -- addToStore. It is addressed according to some hash algorithm
  -- applied to the nar serialization via some 'NarHashMode'.
  | TextIngestionMethod
  -- ^ The path is a plain file added via makeTextPath or
  -- addTextToStore. It is addressed according to a sha256sum of the
  -- file contents.
  deriving (ContentAddressMethod -> ContentAddressMethod -> Bool
(ContentAddressMethod -> ContentAddressMethod -> Bool)
-> (ContentAddressMethod -> ContentAddressMethod -> Bool)
-> Eq ContentAddressMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContentAddressMethod -> ContentAddressMethod -> Bool
== :: ContentAddressMethod -> ContentAddressMethod -> Bool
$c/= :: ContentAddressMethod -> ContentAddressMethod -> Bool
/= :: ContentAddressMethod -> ContentAddressMethod -> Bool
Eq, (forall x. ContentAddressMethod -> Rep ContentAddressMethod x)
-> (forall x. Rep ContentAddressMethod x -> ContentAddressMethod)
-> Generic ContentAddressMethod
forall x. Rep ContentAddressMethod x -> ContentAddressMethod
forall x. ContentAddressMethod -> Rep ContentAddressMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ContentAddressMethod -> Rep ContentAddressMethod x
from :: forall x. ContentAddressMethod -> Rep ContentAddressMethod x
$cto :: forall x. Rep ContentAddressMethod x -> ContentAddressMethod
to :: forall x. Rep ContentAddressMethod x -> ContentAddressMethod
Generic, Eq ContentAddressMethod
Eq ContentAddressMethod =>
(ContentAddressMethod -> ContentAddressMethod -> Ordering)
-> (ContentAddressMethod -> ContentAddressMethod -> Bool)
-> (ContentAddressMethod -> ContentAddressMethod -> Bool)
-> (ContentAddressMethod -> ContentAddressMethod -> Bool)
-> (ContentAddressMethod -> ContentAddressMethod -> Bool)
-> (ContentAddressMethod
    -> ContentAddressMethod -> ContentAddressMethod)
-> (ContentAddressMethod
    -> ContentAddressMethod -> ContentAddressMethod)
-> Ord ContentAddressMethod
ContentAddressMethod -> ContentAddressMethod -> Bool
ContentAddressMethod -> ContentAddressMethod -> Ordering
ContentAddressMethod
-> ContentAddressMethod -> ContentAddressMethod
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ContentAddressMethod -> ContentAddressMethod -> Ordering
compare :: ContentAddressMethod -> ContentAddressMethod -> Ordering
$c< :: ContentAddressMethod -> ContentAddressMethod -> Bool
< :: ContentAddressMethod -> ContentAddressMethod -> Bool
$c<= :: ContentAddressMethod -> ContentAddressMethod -> Bool
<= :: ContentAddressMethod -> ContentAddressMethod -> Bool
$c> :: ContentAddressMethod -> ContentAddressMethod -> Bool
> :: ContentAddressMethod -> ContentAddressMethod -> Bool
$c>= :: ContentAddressMethod -> ContentAddressMethod -> Bool
>= :: ContentAddressMethod -> ContentAddressMethod -> Bool
$cmax :: ContentAddressMethod
-> ContentAddressMethod -> ContentAddressMethod
max :: ContentAddressMethod
-> ContentAddressMethod -> ContentAddressMethod
$cmin :: ContentAddressMethod
-> ContentAddressMethod -> ContentAddressMethod
min :: ContentAddressMethod
-> ContentAddressMethod -> ContentAddressMethod
Ord, Int -> ContentAddressMethod -> ShowS
[ContentAddressMethod] -> ShowS
ContentAddressMethod -> String
(Int -> ContentAddressMethod -> ShowS)
-> (ContentAddressMethod -> String)
-> ([ContentAddressMethod] -> ShowS)
-> Show ContentAddressMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContentAddressMethod -> ShowS
showsPrec :: Int -> ContentAddressMethod -> ShowS
$cshow :: ContentAddressMethod -> String
show :: ContentAddressMethod -> String
$cshowList :: [ContentAddressMethod] -> ShowS
showList :: [ContentAddressMethod] -> ShowS
Show)

-- | An address for a content-addressable store path, i.e. one whose
-- store path hash is purely a function of its contents (as opposed to
-- paths that are derivation outputs, whose hashes are a function of
-- the contents of the derivation file instead).
--
-- For backwards-compatibility reasons, the same information is
-- encodable in multiple ways, depending on the method used to add the
-- path to the store. These unfortunately result in separate store
-- paths.
data ContentAddress = ContentAddress
  ContentAddressMethod
  (DSum HashAlgo Digest)
  deriving (ContentAddress -> ContentAddress -> Bool
(ContentAddress -> ContentAddress -> Bool)
-> (ContentAddress -> ContentAddress -> Bool) -> Eq ContentAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContentAddress -> ContentAddress -> Bool
== :: ContentAddress -> ContentAddress -> Bool
$c/= :: ContentAddress -> ContentAddress -> Bool
/= :: ContentAddress -> ContentAddress -> Bool
Eq, (forall x. ContentAddress -> Rep ContentAddress x)
-> (forall x. Rep ContentAddress x -> ContentAddress)
-> Generic ContentAddress
forall x. Rep ContentAddress x -> ContentAddress
forall x. ContentAddress -> Rep ContentAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ContentAddress -> Rep ContentAddress x
from :: forall x. ContentAddress -> Rep ContentAddress x
$cto :: forall x. Rep ContentAddress x -> ContentAddress
to :: forall x. Rep ContentAddress x -> ContentAddress
Generic, Eq ContentAddress
Eq ContentAddress =>
(ContentAddress -> ContentAddress -> Ordering)
-> (ContentAddress -> ContentAddress -> Bool)
-> (ContentAddress -> ContentAddress -> Bool)
-> (ContentAddress -> ContentAddress -> Bool)
-> (ContentAddress -> ContentAddress -> Bool)
-> (ContentAddress -> ContentAddress -> ContentAddress)
-> (ContentAddress -> ContentAddress -> ContentAddress)
-> Ord ContentAddress
ContentAddress -> ContentAddress -> Bool
ContentAddress -> ContentAddress -> Ordering
ContentAddress -> ContentAddress -> ContentAddress
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ContentAddress -> ContentAddress -> Ordering
compare :: ContentAddress -> ContentAddress -> Ordering
$c< :: ContentAddress -> ContentAddress -> Bool
< :: ContentAddress -> ContentAddress -> Bool
$c<= :: ContentAddress -> ContentAddress -> Bool
<= :: ContentAddress -> ContentAddress -> Bool
$c> :: ContentAddress -> ContentAddress -> Bool
> :: ContentAddress -> ContentAddress -> Bool
$c>= :: ContentAddress -> ContentAddress -> Bool
>= :: ContentAddress -> ContentAddress -> Bool
$cmax :: ContentAddress -> ContentAddress -> ContentAddress
max :: ContentAddress -> ContentAddress -> ContentAddress
$cmin :: ContentAddress -> ContentAddress -> ContentAddress
min :: ContentAddress -> ContentAddress -> ContentAddress
Ord, Int -> ContentAddress -> ShowS
[ContentAddress] -> ShowS
ContentAddress -> String
(Int -> ContentAddress -> ShowS)
-> (ContentAddress -> String)
-> ([ContentAddress] -> ShowS)
-> Show ContentAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContentAddress -> ShowS
showsPrec :: Int -> ContentAddress -> ShowS
$cshow :: ContentAddress -> String
show :: ContentAddress -> String
$cshowList :: [ContentAddress] -> ShowS
showList :: [ContentAddress] -> ShowS
Show)

-- | Marshall `ContentAddressableAddress` to `Text`
-- in form suitable for remote protocol usage.
buildContentAddress :: ContentAddress -> Text
buildContentAddress :: ContentAddress -> Text
buildContentAddress =
  Text -> Text
Data.Text.Lazy.toStrict
  (Text -> Text)
-> (ContentAddress -> Text) -> ContentAddress -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Data.Text.Lazy.Builder.toLazyText
  (Builder -> Text)
-> (ContentAddress -> Builder) -> ContentAddress -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentAddress -> Builder
contentAddressBuilder

contentAddressBuilder :: ContentAddress -> Builder
contentAddressBuilder :: ContentAddress -> Builder
contentAddressBuilder (ContentAddress ContentAddressMethod
method DSum HashAlgo Digest
digest) = case ContentAddressMethod
method of
  ContentAddressMethod
TextIngestionMethod ->
    Builder
"text:"
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> DSum HashAlgo Digest -> Builder
System.Nix.Hash.algoDigestBuilder DSum HashAlgo Digest
digest
  FileIngestionMethod FileIngestionMethod
r ->
    Builder
"fixed:"
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FileIngestionMethod -> Builder
fileIngestionMethodBuilder FileIngestionMethod
r
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> DSum HashAlgo Digest -> Builder
System.Nix.Hash.algoDigestBuilder DSum HashAlgo Digest
digest

fileIngestionMethodBuilder :: FileIngestionMethod -> Builder
fileIngestionMethodBuilder :: FileIngestionMethod -> Builder
fileIngestionMethodBuilder = \case
  FileIngestionMethod
FileIngestionMethod_Flat -> Builder
""
  FileIngestionMethod
FileIngestionMethod_FileRecursive -> Builder
"r:"

-- | Parse `ContentAddressableAddress` from `ByteString`
parseContentAddress
  :: Text -> Either String ContentAddress
parseContentAddress :: Text -> Either String ContentAddress
parseContentAddress =
  Parser ContentAddress -> Text -> Either String ContentAddress
forall a. Parser a -> Text -> Either String a
Data.Attoparsec.Text.parseOnly Parser ContentAddress
contentAddressParser

-- | Parser for content addressable field
contentAddressParser :: Parser ContentAddress
contentAddressParser :: Parser ContentAddress
contentAddressParser = do
  ContentAddressMethod
method <- Parser ContentAddressMethod
parseContentAddressMethod
  Either String (DSum HashAlgo Digest)
digest <- Parser (Either String (DSum HashAlgo Digest))
parseTypedDigest
  case Either String (DSum HashAlgo Digest)
digest of
    Left String
e -> String -> Parser ContentAddress
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
    Right DSum HashAlgo Digest
x -> ContentAddress -> Parser ContentAddress
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (ContentAddress -> Parser ContentAddress)
-> ContentAddress -> Parser ContentAddress
forall a b. (a -> b) -> a -> b
$ ContentAddressMethod -> DSum HashAlgo Digest -> ContentAddress
ContentAddress ContentAddressMethod
method DSum HashAlgo Digest
x

parseContentAddressMethod :: Parser ContentAddressMethod
parseContentAddressMethod :: Parser ContentAddressMethod
parseContentAddressMethod =
      ContentAddressMethod
TextIngestionMethod ContentAddressMethod
-> Parser Text Text -> Parser ContentAddressMethod
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Text Text
"text:"
  Parser ContentAddressMethod
-> Parser ContentAddressMethod -> Parser ContentAddressMethod
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FileIngestionMethod -> ContentAddressMethod
FileIngestionMethod (FileIngestionMethod -> ContentAddressMethod)
-> Parser Text Text
-> Parser Text (FileIngestionMethod -> ContentAddressMethod)
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Text Text
"fixed:"
  Parser Text (FileIngestionMethod -> ContentAddressMethod)
-> Parser Text FileIngestionMethod -> Parser ContentAddressMethod
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FileIngestionMethod
FileIngestionMethod_FileRecursive FileIngestionMethod
-> Parser Text Text -> Parser Text FileIngestionMethod
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Text Text
"r:" 
       Parser Text FileIngestionMethod
-> Parser Text FileIngestionMethod
-> Parser Text FileIngestionMethod
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FileIngestionMethod -> Parser Text FileIngestionMethod
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileIngestionMethod
FileIngestionMethod_Flat)

parseTypedDigest :: Parser (Either String (DSum HashAlgo Digest))
parseTypedDigest :: Parser (Either String (DSum HashAlgo Digest))
parseTypedDigest = Text -> Text -> Either String (DSum HashAlgo Digest)
System.Nix.Hash.mkNamedDigest (Text -> Text -> Either String (DSum HashAlgo Digest))
-> Parser Text Text
-> Parser Text (Text -> Either String (DSum HashAlgo Digest))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
parseHashType Parser Text (Text -> Either String (DSum HashAlgo Digest))
-> Parser Text Text
-> Parser (Either String (DSum HashAlgo Digest))
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text
parseHash
  where
    parseHashType :: Parser Text
    parseHashType :: Parser Text Text
parseHashType =
      (Parser Text Text
"sha256" Parser Text Text -> Parser Text Text -> Parser Text Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Text
"sha512" Parser Text Text -> Parser Text Text -> Parser Text Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Text
"sha1" Parser Text Text -> Parser Text Text -> Parser Text Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Text
"md5") Parser Text Text -> Parser Text Text -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser Text Text
":" Parser Text Text -> Parser Text Text -> Parser Text Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Text
"-")

    parseHash :: Parser Text
    parseHash :: Parser Text Text
parseHash = (Char -> Bool) -> Parser Text Text
Data.Attoparsec.Text.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':')