{-# 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 :: FileContent -> Either Errormsg (Errormsg, FileContent, FileContent)
parsePubKey = FileContent -> Either Errormsg (Errormsg, FileContent, FileContent)
parsePubOrSig

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

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

printPubKey :: KeyID -> PubKey -> Comment -> FileContent
printPubKey :: FileContent -> FileContent -> Errormsg -> FileContent
printPubKey FileContent
keyID FileContent
pubKey Errormsg
comment = [Word8] -> FileContent
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")) FileContent -> FileContent -> FileContent
`B.append`
                                   [Word8] -> FileContent
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w Errormsg
"\n") FileContent -> FileContent -> FileContent
`B.append`
                                   FileContent -> FileContent
encode (
                                     [Word8] -> FileContent
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w Errormsg
"Ed") FileContent -> FileContent -> FileContent
`B.append` -- signify file format magic
                                     FileContent
keyID FileContent -> FileContent -> FileContent
`B.append`
                                     FileContent
pubKey
                                   ) FileContent -> FileContent -> FileContent
`B.append`
                                   [Word8] -> FileContent
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 :: FileContent -> FileContent -> Errormsg -> FileContent
printSignature FileContent
keyID FileContent
sig Errormsg
comment = [Word8] -> FileContent
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)) FileContent -> FileContent -> FileContent
`B.append`
                                   [Word8] -> FileContent
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w Errormsg
"\n") FileContent -> FileContent -> FileContent
`B.append`
                                   FileContent -> FileContent
encode (
                                     [Word8] -> FileContent
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w Errormsg
"Ed") FileContent -> FileContent -> FileContent
`B.append` -- signify file format magic
                                     FileContent
keyID FileContent -> FileContent -> FileContent
`B.append`
                                     FileContent
sig
                                   ) FileContent -> FileContent -> FileContent
`B.append`
                                   [Word8] -> FileContent
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 :: FileContent
-> FileContent
-> FileContent
-> SecKey
-> FileContent
-> Errormsg
-> FileContent
printSecKey FileContent
keyID FileContent
passphrase FileContent
salt (DANGER.SecKeyBytes FileContent
secKeyBytes) FileContent
pubKeyBytes Errormsg
comment =
  let rounds :: Int
rounds = Int
42
      longkey :: FileContent
longkey = FileContent
secKeyBytes FileContent -> FileContent -> FileContent
`B.append` FileContent
pubKeyBytes
      params :: Parameters
params = Parameters :: Int -> Int -> Parameters
Parameters {iterCounts :: Int
iterCounts = Int
rounds, outputLength :: Int
outputLength = FileContent -> Int
B.length FileContent
longkey}
      hashpw :: FileContent
hashpw = Parameters -> FileContent -> FileContent -> FileContent
forall pass salt output.
(ByteArray pass, ByteArray salt, ByteArray output) =>
Parameters -> pass -> salt -> output
generate Parameters
params FileContent
passphrase FileContent
salt
      secdata :: FileContent
secdata = [Word8] -> FileContent
B.pack ([Word8] -> FileContent) -> [Word8] -> FileContent
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8 -> Word8) -> FileContent -> FileContent -> [Word8]
forall a.
(Word8 -> Word8 -> a) -> FileContent -> FileContent -> [a]
B.zipWith Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor FileContent
longkey FileContent
hashpw
      cksum :: FileContent
cksum = Int -> FileContent -> FileContent
B.take Int
8 (FileContent -> FileContent) -> FileContent -> FileContent
forall a b. (a -> b) -> a -> b
$ FileContent -> FileContent
H.hash FileContent
longkey
      fulldata :: FileContent
fulldata = [Word8] -> FileContent
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w Errormsg
"Ed") FileContent -> FileContent -> FileContent
`B.append` -- signify file format magic
                 [Word8] -> FileContent
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w Errormsg
"BK") FileContent -> FileContent -> FileContent
`B.append` -- signify file format magic
                 [Word8] -> FileContent
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w (if FileContent
passphrase FileContent -> FileContent -> Bool
forall a. Eq a => a -> a -> Bool
/= FileContent
B.empty then Errormsg
"\NUL\NUL\NUL*" else Errormsg
"\NUL\NUL\NUL\NUL")) FileContent -> FileContent -> FileContent
`B.append` -- manually hack rounds magic number 42 for now, TODO cleanly
                 FileContent
salt FileContent -> FileContent -> FileContent
`B.append`
                 FileContent
cksum FileContent -> FileContent -> FileContent
`B.append`
                 FileContent
keyID FileContent -> FileContent -> FileContent
`B.append`
                 (if FileContent
passphrase FileContent -> FileContent -> Bool
forall a. Eq a => a -> a -> Bool
/= FileContent
B.empty then FileContent
secdata else FileContent
longkey)
  in [Word8] -> FileContent
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")) FileContent -> FileContent -> FileContent
`B.append`
     [Word8] -> FileContent
B.pack ((Char -> Word8) -> Errormsg -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w Errormsg
"\n") FileContent -> FileContent -> FileContent
`B.append`
     FileContent -> FileContent
encode FileContent
fulldata FileContent -> FileContent -> FileContent
`B.append`
     [Word8] -> FileContent
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 :: FileContent -> Either Errormsg (Errormsg, FileContent, FileContent)
parsePubOrSig FileContent
file = do
  (Errormsg
comment, FileContent
rest) <- FileContent -> Either Errormsg (Errormsg, FileContent)
parseSignifyFileContent FileContent
file
  let (FileContent
keyid, FileContent
signifydata) = Int -> FileContent -> (FileContent, FileContent)
B.splitAt Int
8 FileContent
rest
  (Errormsg, FileContent, FileContent)
-> Either Errormsg (Errormsg, FileContent, FileContent)
forall (m :: * -> *) a. Monad m => a -> m a
return (Errormsg
comment, FileContent
keyid, FileContent
signifydata)

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

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