{-# LANGUAGE NoImplicitPrelude #-}

module Crypto.ECC.Signify ( parsePubKey
                          , parseSignature
                          , parseSecKey
                          , printPubKey
                          , printSignature
                          , printSecKey
                          ) where

import Text.Parsec
import Data.Either (Either(..))
import Data.String (String)
import Data.Function (($))
import Data.List ((++),drop,map)
import Data.Eq ((==),(/=))
import Data.Bool ((&&))
import Text.Show (show)
import Control.Monad
import qualified Data.ByteString as B
import Data.ByteString.Internal (c2w)
import Data.ByteString.Base64
import Crypto.ECC.Ed25519.Sign
import qualified Crypto.ECC.Ed25519.Internal.Ed25519 as DANGER
import Crypto.KDF.BCryptPBKDF
import Data.Bits
import qualified Crypto.Hash.SHA512 as H

type KeyID = B.ByteString
type Comment = String
type FileContent = B.ByteString
type Passphrase = B.ByteString
type Errormsg = String
type Salt = B.ByteString

parsePubKey :: FileContent -> Either Errormsg (Comment, KeyID, PubKey)
parsePubKey :: ByteString -> Either Errormsg (Errormsg, ByteString, ByteString)
parsePubKey = ByteString -> Either Errormsg (Errormsg, ByteString, ByteString)
parsePubOrSig

parseSignature :: FileContent -> Either Errormsg (Comment, KeyID, Signature)
parseSignature :: ByteString -> Either Errormsg (Errormsg, ByteString, ByteString)
parseSignature = ByteString -> Either Errormsg (Errormsg, ByteString, ByteString)
parsePubOrSig

parseSecKey :: Passphrase -> FileContent -> Either Errormsg (Comment, KeyID, SecKey)
parseSecKey :: ByteString
-> ByteString -> Either Errormsg (Errormsg, ByteString, SecKey)
parseSecKey ByteString
pass ByteString
file = do
  (Errormsg
comment, ByteString
rest) <- ByteString -> Either Errormsg (Errormsg, ByteString)
parseSignifyFileContent ByteString
file
  let (ByteString
kdfalg,ByteString
rest2) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
2 ByteString
rest
      (ByteString
kdfrounds,ByteString
rest3) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
4 ByteString
rest2
      (ByteString
salt,ByteString
rest4) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
16 ByteString
rest3
      (ByteString
cksum,ByteString
rest5) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
8 ByteString
rest4
      (ByteString
keyid,ByteString
encbytes) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
8 ByteString
rest5
--      rounds = fromBytes $ B.reverse kdfrounds
      rounds :: Int
rounds = Int
42 -- magic number, TODO: get rid of
      params :: Parameters
params = Parameters {iterCounts :: Int
iterCounts = Int
rounds, outputLength :: Int
outputLength = ByteString -> Int
B.length ByteString
encbytes}
      hashpw :: ByteString
hashpw = Parameters -> ByteString -> ByteString -> ByteString
forall pass salt output.
(ByteArray pass, ByteArray salt, ByteArray output) =>
Parameters -> pass -> salt -> output
generate Parameters
params ByteString
pass ByteString
salt
      secbytes :: ByteString
secbytes = [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> [Word8]
forall a. (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
B.zipWith Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor ByteString
encbytes ByteString
hashpw
      resultbytes :: ByteString
resultbytes = if ByteString
pass ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
B.empty then ByteString
encbytes else ByteString
secbytes
  if Int -> ByteString -> ByteString
B.take Int
8 (ByteString -> ByteString
H.hash ByteString
resultbytes) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
cksum
    then (Errormsg, ByteString, SecKey)
-> Either Errormsg (Errormsg, ByteString, SecKey)
forall a. a -> Either Errormsg a
forall (m :: * -> *) a. Monad m => a -> m a
return (Errormsg
comment, ByteString
keyid, ByteString -> SecKey
DANGER.SecKeyBytes ByteString
resultbytes)
    else Errormsg -> Either Errormsg (Errormsg, ByteString, SecKey)
forall a b. a -> Either a b
Left Errormsg
"signify-hs: incorrect passphrase"

printPubKey :: KeyID -> PubKey -> Comment -> FileContent
printPubKey :: ByteString -> ByteString -> Errormsg -> ByteString
printPubKey ByteString
keyID ByteString
pubKey Errormsg
comment = [Word8] -> ByteString
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w (Errormsg
"untrusted comment: " Errormsg -> Errormsg -> Errormsg
forall a. [a] -> [a] -> [a]
++ Errormsg
comment Errormsg -> Errormsg -> Errormsg
forall a. [a] -> [a] -> [a]
++ Errormsg
" public key")) ByteString -> ByteString -> ByteString
`B.append`
                                   [Word8] -> ByteString
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w Errormsg
"\n") ByteString -> ByteString -> ByteString
`B.append`
                                   ByteString -> ByteString
encode (
                                     [Word8] -> ByteString
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w Errormsg
"Ed") ByteString -> ByteString -> ByteString
`B.append` -- signify file format magic
                                     ByteString
keyID ByteString -> ByteString -> ByteString
`B.append`
                                     ByteString
pubKey
                                   ) ByteString -> ByteString -> ByteString
`B.append`
                                   [Word8] -> ByteString
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w Errormsg
"\n")

printSignature :: KeyID -> Signature -> Comment -> FileContent
printSignature :: ByteString -> ByteString -> Errormsg -> ByteString
printSignature ByteString
keyID ByteString
sig Errormsg
comment = [Word8] -> ByteString
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w (Errormsg
"untrusted comment: " Errormsg -> Errormsg -> Errormsg
forall a. [a] -> [a] -> [a]
++ Errormsg
comment)) ByteString -> ByteString -> ByteString
`B.append`
                                   [Word8] -> ByteString
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w Errormsg
"\n") ByteString -> ByteString -> ByteString
`B.append`
                                   ByteString -> ByteString
encode (
                                     [Word8] -> ByteString
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w Errormsg
"Ed") ByteString -> ByteString -> ByteString
`B.append` -- signify file format magic
                                     ByteString
keyID ByteString -> ByteString -> ByteString
`B.append`
                                     ByteString
sig
                                   ) ByteString -> ByteString -> ByteString
`B.append`
                                   [Word8] -> ByteString
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w Errormsg
"\n")

printSecKey :: KeyID -> Passphrase -> Salt -> SecKey -> PubKey -> Comment -> FileContent
printSecKey :: ByteString
-> ByteString
-> ByteString
-> SecKey
-> ByteString
-> Errormsg
-> ByteString
printSecKey ByteString
keyID ByteString
passphrase ByteString
salt (DANGER.SecKeyBytes ByteString
secKeyBytes) ByteString
pubKeyBytes Errormsg
comment =
  let rounds :: Int
rounds = Int
42
      longkey :: ByteString
longkey = ByteString
secKeyBytes ByteString -> ByteString -> ByteString
`B.append` ByteString
pubKeyBytes
      params :: Parameters
params = Parameters {iterCounts :: Int
iterCounts = Int
rounds, outputLength :: Int
outputLength = ByteString -> Int
B.length ByteString
longkey}
      hashpw :: ByteString
hashpw = Parameters -> ByteString -> ByteString -> ByteString
forall pass salt output.
(ByteArray pass, ByteArray salt, ByteArray output) =>
Parameters -> pass -> salt -> output
generate Parameters
params ByteString
passphrase ByteString
salt
      secdata :: ByteString
secdata = [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> [Word8]
forall a. (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
B.zipWith Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor ByteString
longkey ByteString
hashpw
      cksum :: ByteString
cksum = Int -> ByteString -> ByteString
B.take Int
8 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
H.hash ByteString
longkey
      fulldata :: ByteString
fulldata = [Word8] -> ByteString
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w Errormsg
"Ed") ByteString -> ByteString -> ByteString
`B.append` -- signify file format magic
                 [Word8] -> ByteString
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w Errormsg
"BK") ByteString -> ByteString -> ByteString
`B.append` -- signify file format magic
                 [Word8] -> ByteString
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w (if ByteString
passphrase ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
B.empty then Errormsg
"\NUL\NUL\NUL*" else Errormsg
"\NUL\NUL\NUL\NUL")) ByteString -> ByteString -> ByteString
`B.append` -- manually hack rounds magic number 42 for now, TODO cleanly
                 ByteString
salt ByteString -> ByteString -> ByteString
`B.append`
                 ByteString
cksum ByteString -> ByteString -> ByteString
`B.append`
                 ByteString
keyID ByteString -> ByteString -> ByteString
`B.append`
                 (if ByteString
passphrase ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
B.empty then ByteString
secdata else ByteString
longkey)
  in [Word8] -> ByteString
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w (Errormsg
"untrusted comment: " Errormsg -> Errormsg -> Errormsg
forall a. [a] -> [a] -> [a]
++ Errormsg
comment Errormsg -> Errormsg -> Errormsg
forall a. [a] -> [a] -> [a]
++ Errormsg
" secret key")) ByteString -> ByteString -> ByteString
`B.append`
     [Word8] -> ByteString
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w Errormsg
"\n") ByteString -> ByteString -> ByteString
`B.append`
     ByteString -> ByteString
encode ByteString
fulldata ByteString -> ByteString -> ByteString
`B.append`
     [Word8] -> ByteString
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w Errormsg
"\n")

{-
-- Read bytes in big-endian order (most significant byte first)
-- Little-endian order is fromBytes . BS.reverse
fromBytes :: (Bits a, Num a) => B.ByteString -> a
fromBytes = B.foldl' f 0
  where
    f a b = a `shiftL` 8 .|. fromIntegral b

toBytes :: (Bits a, Num a) => a -> B.ByteString
toBytes = undefined
-- -}

parsePubOrSig :: FileContent -> Either Errormsg (Comment, KeyID, B.ByteString)
parsePubOrSig :: ByteString -> Either Errormsg (Errormsg, ByteString, ByteString)
parsePubOrSig ByteString
file = do
  (Errormsg
comment, ByteString
rest) <- ByteString -> Either Errormsg (Errormsg, ByteString)
parseSignifyFileContent ByteString
file
  let (ByteString
keyid, ByteString
signifydata) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
8 ByteString
rest
  (Errormsg, ByteString, ByteString)
-> Either Errormsg (Errormsg, ByteString, ByteString)
forall a. a -> Either Errormsg a
forall (m :: * -> *) a. Monad m => a -> m a
return (Errormsg
comment, ByteString
keyid, ByteString
signifydata)

parseSignifyFileContent :: FileContent -> Either Errormsg (Comment, B.ByteString)
parseSignifyFileContent :: ByteString -> Either Errormsg (Errormsg, ByteString)
parseSignifyFileContent ByteString
file = do
  let res :: Either ParseError (Errormsg, ByteString)
res = Parsec ByteString () (Errormsg, ByteString)
-> Errormsg
-> ByteString
-> Either ParseError (Errormsg, ByteString)
forall s t a.
Stream s Identity t =>
Parsec s () a -> Errormsg -> s -> Either ParseError a
parse Parsec ByteString () (Errormsg, ByteString)
forall u. Parsec ByteString u (Errormsg, ByteString)
signifyFile Errormsg
"(unknown)" ByteString
file
  case Either ParseError (Errormsg, ByteString)
res of
    Left ParseError
s -> Errormsg -> Either Errormsg (Errormsg, ByteString)
forall a b. a -> Either a b
Left (Errormsg -> Either Errormsg (Errormsg, ByteString))
-> Errormsg -> Either Errormsg (Errormsg, ByteString)
forall a b. (a -> b) -> a -> b
$ ParseError -> Errormsg
forall a. Show a => a -> Errormsg
show ParseError
s
    Right (Errormsg
comment,ByteString
bytes) -> do
      let (ByteString
alg,ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
2 ByteString
bytes
      if ByteString
alg ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= [Word8] -> ByteString
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w Errormsg
"Ed") Bool -> Bool -> Bool
&& ByteString
alg ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= [Word8] -> ByteString
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w Errormsg
"ED")
        then Errormsg -> Either Errormsg (Errormsg, ByteString)
forall a b. a -> Either a b
Left Errormsg
"currently unsupported signing algorithm"
        else (Errormsg, ByteString) -> Either Errormsg (Errormsg, ByteString)
forall a. a -> Either Errormsg a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Errormsg -> Errormsg
forall a. Int -> [a] -> [a]
drop Int
19 Errormsg
comment, ByteString
rest)

signifyFile :: Parsec FileContent u (Comment, B.ByteString)
signifyFile :: forall u. Parsec ByteString u (Errormsg, ByteString)
signifyFile = do
  Errormsg
comment <- ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Errormsg
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Errormsg -> ParsecT ByteString u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Errormsg -> ParsecT s u m Char
noneOf Errormsg
"\r\n")
  Char
_ <- ParsecT ByteString u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
endOfLine
  Errormsg
base64data <- ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity Errormsg
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Errormsg -> ParsecT ByteString u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Errormsg -> ParsecT s u m Char
noneOf Errormsg
"\r\n")
  Char
_ <- ParsecT ByteString u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
endOfLine
  let base64decoded :: Either Errormsg ByteString
base64decoded = ByteString -> Either Errormsg ByteString
decode (ByteString -> Either Errormsg ByteString)
-> ByteString -> Either Errormsg ByteString
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w Errormsg
base64data
  case Either Errormsg ByteString
base64decoded of
    Left Errormsg
s -> Errormsg -> Parsec ByteString u (Errormsg, ByteString)
forall s u (m :: * -> *) a. Errormsg -> ParsecT s u m a
parserFail Errormsg
s
    Right ByteString
dat -> (Errormsg, ByteString)
-> Parsec ByteString u (Errormsg, ByteString)
forall a. a -> ParsecT ByteString u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Errormsg
comment,ByteString
dat)