{-# language AllowAmbiguousTypes #-}
{-# language ScopedTypeVariables #-}
{-# language RankNTypes          #-}
{-# language DataKinds           #-}

module System.Nix.Store.Remote.Parsers
  ( parseContentAddressableAddress
  )
where

import           Data.Attoparsec.ByteString.Char8
import           System.Nix.Hash
import           System.Nix.StorePath           ( ContentAddressableAddress(..)
                                                , NarHashMode(..)
                                                )
import           Crypto.Hash                    ( SHA256 )

-- | Parse `ContentAddressableAddress` from `ByteString`
parseContentAddressableAddress
  :: ByteString -> Either String ContentAddressableAddress
parseContentAddressableAddress :: ByteString -> Either String ContentAddressableAddress
parseContentAddressableAddress =
  Parser ContentAddressableAddress
-> ByteString -> Either String ContentAddressableAddress
forall a. Parser a -> ByteString -> Either String a
Data.Attoparsec.ByteString.Char8.parseOnly Parser ContentAddressableAddress
contentAddressableAddressParser

-- | Parser for content addressable field
contentAddressableAddressParser :: Parser ContentAddressableAddress
contentAddressableAddressParser :: Parser ContentAddressableAddress
contentAddressableAddressParser = Parser ContentAddressableAddress
caText Parser ContentAddressableAddress
-> Parser ContentAddressableAddress
-> Parser ContentAddressableAddress
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ContentAddressableAddress
caFixed

-- | Parser for @text:sha256:<h>@
caText :: Parser ContentAddressableAddress
caText :: Parser ContentAddressableAddress
caText = do
  ByteString
_      <- Parser ByteString ByteString
"text:sha256:"
  Either String (Digest SHA256)
digest <- BaseEncoding -> Text -> Either String (Digest SHA256)
forall a.
HashAlgorithm a =>
BaseEncoding -> Text -> Either String (Digest a)
decodeDigestWith @SHA256 BaseEncoding
NixBase32 (Text -> Either String (Digest SHA256))
-> Parser ByteString Text
-> Parser ByteString (Either String (Digest SHA256))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
parseHash
  (String -> Parser ContentAddressableAddress)
-> (ContentAddressableAddress -> Parser ContentAddressableAddress)
-> Either String ContentAddressableAddress
-> Parser ContentAddressableAddress
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser ContentAddressableAddress
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ContentAddressableAddress -> Parser ContentAddressableAddress
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String ContentAddressableAddress
 -> Parser ContentAddressableAddress)
-> Either String ContentAddressableAddress
-> Parser ContentAddressableAddress
forall a b. (a -> b) -> a -> b
$ Digest SHA256 -> ContentAddressableAddress
Text (Digest SHA256 -> ContentAddressableAddress)
-> Either String (Digest SHA256)
-> Either String ContentAddressableAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String (Digest SHA256)
digest

-- | Parser for @fixed:<r?>:<ht>:<h>@
caFixed :: Parser ContentAddressableAddress
caFixed :: Parser ContentAddressableAddress
caFixed = do
  ByteString
_           <- Parser ByteString ByteString
"fixed:"
  NarHashMode
narHashMode <- (NarHashMode
Recursive NarHashMode
-> Parser ByteString ByteString -> Parser ByteString NarHashMode
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ByteString
"r:") Parser ByteString NarHashMode
-> Parser ByteString NarHashMode -> Parser ByteString NarHashMode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (NarHashMode
RegularFile NarHashMode
-> Parser ByteString ByteString -> Parser ByteString NarHashMode
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ByteString
"")
  Either String SomeNamedDigest
digest      <- Parser (Either String SomeNamedDigest)
parseTypedDigest
  (String -> Parser ContentAddressableAddress)
-> (ContentAddressableAddress -> Parser ContentAddressableAddress)
-> Either String ContentAddressableAddress
-> Parser ContentAddressableAddress
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser ContentAddressableAddress
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ContentAddressableAddress -> Parser ContentAddressableAddress
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String ContentAddressableAddress
 -> Parser ContentAddressableAddress)
-> Either String ContentAddressableAddress
-> Parser ContentAddressableAddress
forall a b. (a -> b) -> a -> b
$ NarHashMode -> SomeNamedDigest -> ContentAddressableAddress
Fixed NarHashMode
narHashMode (SomeNamedDigest -> ContentAddressableAddress)
-> Either String SomeNamedDigest
-> Either String ContentAddressableAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String SomeNamedDigest
digest

parseTypedDigest :: Parser (Either String SomeNamedDigest)
parseTypedDigest :: Parser (Either String SomeNamedDigest)
parseTypedDigest = Text -> Text -> Either String SomeNamedDigest
mkNamedDigest (Text -> Text -> Either String SomeNamedDigest)
-> Parser ByteString Text
-> Parser ByteString (Text -> Either String SomeNamedDigest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
parseHashType Parser ByteString (Text -> Either String SomeNamedDigest)
-> Parser ByteString Text -> Parser (Either String SomeNamedDigest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
parseHash

parseHashType :: Parser Text
parseHashType :: Parser ByteString Text
parseHashType =
  ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text)
-> Parser ByteString ByteString -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
"sha256" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"sha512" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"sha1" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"md5") Parser ByteString Text
-> Parser ByteString ByteString -> Parser ByteString Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser ByteString ByteString
":" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"-")

parseHash :: Parser Text
parseHash :: Parser ByteString Text
parseHash = ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text)
-> Parser ByteString ByteString -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString ByteString
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':')