{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NamedFieldPuns #-}
{-|
Description : Nix-relevant interfaces to NaCl signatures.
-}

module System.Nix.Signature
  ( Signature(..)
  , signatureParser
  , parseSignature
  , signatureToText
  , NarSignature(..)
  , narSignatureParser
  , parseNarSignature
  , narSignatureToText
  ) where

import Crypto.Error (CryptoFailable(..))
import Data.Attoparsec.Text (Parser)
import Data.ByteString (ByteString)
import Data.Text (Text)
import GHC.Generics (Generic)
import System.Nix.Base (decodeWith, encodeWith, BaseEncoding(Base64))

import qualified Crypto.PubKey.Ed25519 as Ed25519
import qualified Data.Attoparsec.Text
import qualified Data.ByteArray
import qualified Data.Char
import qualified Data.Text

-- | An ed25519 signature.
newtype Signature = Signature Ed25519.Signature
  deriving (Signature -> Signature -> Bool
(Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool) -> Eq Signature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Signature -> Signature -> Bool
== :: Signature -> Signature -> Bool
$c/= :: Signature -> Signature -> Bool
/= :: Signature -> Signature -> Bool
Eq, (forall x. Signature -> Rep Signature x)
-> (forall x. Rep Signature x -> Signature) -> Generic Signature
forall x. Rep Signature x -> Signature
forall x. Signature -> Rep Signature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Signature -> Rep Signature x
from :: forall x. Signature -> Rep Signature x
$cto :: forall x. Rep Signature x -> Signature
to :: forall x. Rep Signature x -> Signature
Generic, Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> String
(Int -> Signature -> ShowS)
-> (Signature -> String)
-> ([Signature] -> ShowS)
-> Show Signature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Signature -> ShowS
showsPrec :: Int -> Signature -> ShowS
$cshow :: Signature -> String
show :: Signature -> String
$cshowList :: [Signature] -> ShowS
showList :: [Signature] -> ShowS
Show)

signatureParser :: Parser Signature
signatureParser :: Parser Signature
signatureParser = do
  Text
encodedSig <-
    (Char -> Bool) -> Parser Text
Data.Attoparsec.Text.takeWhile1
      (\Char
c -> Char -> Bool
Data.Char.isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=')
  ByteString
decodedSig <- case BaseEncoding -> Text -> Either String ByteString
decodeWith BaseEncoding
Base64 Text
encodedSig of
    Left String
e -> String -> Parser Text ByteString
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
    Right ByteString
decodedSig -> ByteString -> Parser Text ByteString
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
decodedSig
  Signature
sig <- case ByteString -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed25519.signature ByteString
decodedSig of
    CryptoFailed CryptoError
e -> (String -> Parser Text Signature
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Text Signature)
-> (CryptoError -> String) -> CryptoError -> Parser Text Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoError -> String
forall a. Show a => a -> String
show) CryptoError
e
    CryptoPassed Signature
sig -> Signature -> Parser Text Signature
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Signature
sig
  Signature -> Parser Signature
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Signature -> Parser Signature) -> Signature -> Parser Signature
forall a b. (a -> b) -> a -> b
$ Signature -> Signature
Signature Signature
sig

parseSignature :: Text -> Either String Signature
parseSignature :: Text -> Either String Signature
parseSignature = Parser Signature -> Text -> Either String Signature
forall a. Parser a -> Text -> Either String a
Data.Attoparsec.Text.parseOnly Parser Signature
signatureParser

signatureToText :: Signature -> Text
signatureToText :: Signature -> Text
signatureToText (Signature Signature
sig) =
  BaseEncoding -> ByteString -> Text
encodeWith BaseEncoding
Base64 (Signature -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
Data.ByteArray.convert Signature
sig :: ByteString)

-- | A detached signature attesting to a nix archive's validity.
data NarSignature = NarSignature
  { -- | The name of the public key used to sign the archive.
    NarSignature -> Text
publicKey :: !Text
  , -- | The archive's signature.
    NarSignature -> Signature
sig :: !Signature
  }
  deriving (NarSignature -> NarSignature -> Bool
(NarSignature -> NarSignature -> Bool)
-> (NarSignature -> NarSignature -> Bool) -> Eq NarSignature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NarSignature -> NarSignature -> Bool
== :: NarSignature -> NarSignature -> Bool
$c/= :: NarSignature -> NarSignature -> Bool
/= :: NarSignature -> NarSignature -> Bool
Eq, (forall x. NarSignature -> Rep NarSignature x)
-> (forall x. Rep NarSignature x -> NarSignature)
-> Generic NarSignature
forall x. Rep NarSignature x -> NarSignature
forall x. NarSignature -> Rep NarSignature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NarSignature -> Rep NarSignature x
from :: forall x. NarSignature -> Rep NarSignature x
$cto :: forall x. Rep NarSignature x -> NarSignature
to :: forall x. Rep NarSignature x -> NarSignature
Generic, Eq NarSignature
Eq NarSignature =>
(NarSignature -> NarSignature -> Ordering)
-> (NarSignature -> NarSignature -> Bool)
-> (NarSignature -> NarSignature -> Bool)
-> (NarSignature -> NarSignature -> Bool)
-> (NarSignature -> NarSignature -> Bool)
-> (NarSignature -> NarSignature -> NarSignature)
-> (NarSignature -> NarSignature -> NarSignature)
-> Ord NarSignature
NarSignature -> NarSignature -> Bool
NarSignature -> NarSignature -> Ordering
NarSignature -> NarSignature -> NarSignature
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 :: NarSignature -> NarSignature -> Ordering
compare :: NarSignature -> NarSignature -> Ordering
$c< :: NarSignature -> NarSignature -> Bool
< :: NarSignature -> NarSignature -> Bool
$c<= :: NarSignature -> NarSignature -> Bool
<= :: NarSignature -> NarSignature -> Bool
$c> :: NarSignature -> NarSignature -> Bool
> :: NarSignature -> NarSignature -> Bool
$c>= :: NarSignature -> NarSignature -> Bool
>= :: NarSignature -> NarSignature -> Bool
$cmax :: NarSignature -> NarSignature -> NarSignature
max :: NarSignature -> NarSignature -> NarSignature
$cmin :: NarSignature -> NarSignature -> NarSignature
min :: NarSignature -> NarSignature -> NarSignature
Ord)

instance Ord Signature where
  compare :: Signature -> Signature -> Ordering
compare (Signature Signature
x) (Signature Signature
y) = let
    xBS :: ByteString
xBS = Signature -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
Data.ByteArray.convert Signature
x :: ByteString
    yBS :: ByteString
yBS = Signature -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
Data.ByteArray.convert Signature
y :: ByteString
    in ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ByteString
xBS ByteString
yBS

narSignatureParser :: Parser NarSignature
narSignatureParser :: Parser NarSignature
narSignatureParser = do
  Text
publicKey <- (Char -> Bool) -> Parser Text
Data.Attoparsec.Text.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':')
  Text
_ <- Text -> Parser Text
Data.Attoparsec.Text.string Text
":"
  Signature
sig <- Parser Signature
signatureParser
  NarSignature -> Parser NarSignature
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NarSignature -> Parser NarSignature)
-> NarSignature -> Parser NarSignature
forall a b. (a -> b) -> a -> b
$ NarSignature {Text
Signature
publicKey :: Text
sig :: Signature
publicKey :: Text
sig :: Signature
..}

parseNarSignature :: Text -> Either String NarSignature
parseNarSignature :: Text -> Either String NarSignature
parseNarSignature = Parser NarSignature -> Text -> Either String NarSignature
forall a. Parser a -> Text -> Either String a
Data.Attoparsec.Text.parseOnly Parser NarSignature
narSignatureParser

narSignatureToText :: NarSignature -> Text
narSignatureToText :: NarSignature -> Text
narSignatureToText NarSignature {Text
Signature
publicKey :: NarSignature -> Text
sig :: NarSignature -> Signature
publicKey :: Text
sig :: Signature
..} =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [ Text
publicKey, Text
":", Signature -> Text
signatureToText Signature
sig ]

instance Show NarSignature where
  show :: NarSignature -> String
show NarSignature
narSig = Text -> String
Data.Text.unpack (NarSignature -> Text
narSignatureToText NarSignature
narSig)