\section{Key}

\begin{code}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE DeriveDataTypeable  #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving  #-}
{-# LANGUAGE StrictData          #-}
{-# LANGUAGE Trustworthy         #-}
module Network.Tox.Crypto.Key where

import           Control.Applicative               ((<$>))
import           Control.Monad                     ((>=>))
import qualified Crypto.Saltine.Class              as Sodium (IsEncoding,
                                                              decode, encode)
import qualified Crypto.Saltine.Core.Box           as Sodium (CombinedKey,
                                                              Nonce, PublicKey,
                                                              SecretKey)
import qualified Crypto.Saltine.Internal.ByteSizes as Sodium (boxBeforeNM,
                                                              boxNonce, boxPK,
                                                              boxSK)
import           Data.Binary                       (Binary)
import qualified Data.Binary                       as Binary (get, put)
import qualified Data.Binary.Get                   as Binary (getByteString,
                                                              runGet)
import qualified Data.Binary.Put                   as Binary (putByteString)
import qualified Data.ByteString                   as ByteString
import qualified Data.ByteString.Base16            as Base16
import qualified Data.ByteString.Lazy              as LazyByteString
import           Data.MessagePack                  (MessagePack (..))
import           Data.Proxy                        (Proxy (..))
import           Data.Typeable                     (Typeable)
import           Test.QuickCheck.Arbitrary         (Arbitrary, arbitrary)
import qualified Test.QuickCheck.Arbitrary         as Arbitrary
import           Text.Read                         (readPrec)


{-------------------------------------------------------------------------------
 -
 - :: Implementation.
 -
 ------------------------------------------------------------------------------}

\end{code}

A Crypto Number is a large fixed size unsigned (non-negative) integer.  Its binary
encoding is as a Big Endian integer in exactly the encoded byte size.  Its
human-readable encoding is as a base-16 number encoded as String.  The NaCl
implementation \href{https://github.com/jedisct1/libsodium}{libsodium} supplies
the functions \texttt{sodium\_bin2hex} and \texttt{sodium\_hex2bin} to aid in
implementing the human-readable encoding.  The in-memory encoding of these
crypto numbers in NaCl already satisfies the binary encoding, so for
applications directly using those APIs, binary encoding and decoding is the
\href{https://en.wikipedia.org/wiki/Identity_function}{identity function}.

\begin{code}

class Sodium.IsEncoding a => CryptoNumber a where
  encodedByteSize :: Proxy a -> Int

\end{code}

Tox uses four kinds of Crypto Numbers:

\begin{tabular}{l|l|l}
  Type         & Bits & Encoded byte size \\
  \hline
  Public Key   & 256  & 32 \\
  Secret Key   & 256  & 32 \\
  Combined Key & 256  & 32 \\
  Nonce        & 192  & 24 \\
\end{tabular}

\begin{code}

instance CryptoNumber Sodium.PublicKey   where { encodedByteSize :: Proxy PublicKey -> Int
encodedByteSize Proxy PublicKey
Proxy = Int
Sodium.boxPK       }
instance CryptoNumber Sodium.SecretKey   where { encodedByteSize :: Proxy SecretKey -> Int
encodedByteSize Proxy SecretKey
Proxy = Int
Sodium.boxSK       }
instance CryptoNumber Sodium.CombinedKey where { encodedByteSize :: Proxy CombinedKey -> Int
encodedByteSize Proxy CombinedKey
Proxy = Int
Sodium.boxBeforeNM }
instance CryptoNumber Sodium.Nonce       where { encodedByteSize :: Proxy Nonce -> Int
encodedByteSize Proxy Nonce
Proxy = Int
Sodium.boxNonce    }

deriving instance Typeable Sodium.PublicKey
deriving instance Typeable Sodium.SecretKey
deriving instance Typeable Sodium.CombinedKey
deriving instance Typeable Sodium.Nonce

newtype Key a = Key { Key a -> a
unKey :: a }
  deriving (Key a -> Key a -> Bool
(Key a -> Key a -> Bool) -> (Key a -> Key a -> Bool) -> Eq (Key a)
forall a. Eq a => Key a -> Key a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key a -> Key a -> Bool
$c/= :: forall a. Eq a => Key a -> Key a -> Bool
== :: Key a -> Key a -> Bool
$c== :: forall a. Eq a => Key a -> Key a -> Bool
Eq, Eq (Key a)
Eq (Key a)
-> (Key a -> Key a -> Ordering)
-> (Key a -> Key a -> Bool)
-> (Key a -> Key a -> Bool)
-> (Key a -> Key a -> Bool)
-> (Key a -> Key a -> Bool)
-> (Key a -> Key a -> Key a)
-> (Key a -> Key a -> Key a)
-> Ord (Key a)
Key a -> Key a -> Bool
Key a -> Key a -> Ordering
Key a -> Key a -> Key a
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
forall a. Ord a => Eq (Key a)
forall a. Ord a => Key a -> Key a -> Bool
forall a. Ord a => Key a -> Key a -> Ordering
forall a. Ord a => Key a -> Key a -> Key a
min :: Key a -> Key a -> Key a
$cmin :: forall a. Ord a => Key a -> Key a -> Key a
max :: Key a -> Key a -> Key a
$cmax :: forall a. Ord a => Key a -> Key a -> Key a
>= :: Key a -> Key a -> Bool
$c>= :: forall a. Ord a => Key a -> Key a -> Bool
> :: Key a -> Key a -> Bool
$c> :: forall a. Ord a => Key a -> Key a -> Bool
<= :: Key a -> Key a -> Bool
$c<= :: forall a. Ord a => Key a -> Key a -> Bool
< :: Key a -> Key a -> Bool
$c< :: forall a. Ord a => Key a -> Key a -> Bool
compare :: Key a -> Key a -> Ordering
$ccompare :: forall a. Ord a => Key a -> Key a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Key a)
Ord, Typeable)

type PublicKey   = Key Sodium.PublicKey
type SecretKey   = Key Sodium.SecretKey
type CombinedKey = Key Sodium.CombinedKey
type Nonce       = Key Sodium.Nonce

instance Sodium.IsEncoding a => Sodium.IsEncoding (Key a) where
  encode :: Key a -> ByteString
encode = a -> ByteString
forall a. IsEncoding a => a -> ByteString
Sodium.encode (a -> ByteString) -> (Key a -> a) -> Key a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key a -> a
forall a. Key a -> a
unKey
  decode :: ByteString -> Maybe (Key a)
decode = (a -> Key a) -> Maybe a -> Maybe (Key a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Key a
forall a. a -> Key a
Key (Maybe a -> Maybe (Key a))
-> (ByteString -> Maybe a) -> ByteString -> Maybe (Key a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe a
forall a. IsEncoding a => ByteString -> Maybe a
Sodium.decode


keyToInteger :: Sodium.IsEncoding a => Key a -> Integer
keyToInteger :: Key a -> Integer
keyToInteger =
  Get Integer -> ByteString -> Integer
forall a. Get a -> ByteString -> a
Binary.runGet Get Integer
forall t. Binary t => Get t
Binary.get (ByteString -> Integer)
-> (Key a -> ByteString) -> Key a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key a -> ByteString
encode
  where
    prefix :: ByteString
prefix = [Word8] -> ByteString
LazyByteString.pack
      [ Word8
0x01 -- Tag: big integer
      , Word8
0x01 -- Sign: positive
      , Word8
0x00, Word8
0x00, Word8
0x00, Word8
0x00, Word8
0x00, Word8
0x00, Word8
0x00, Word8
0x20 -- Length: 32 bytes
      ]
    encode :: Key a -> ByteString
encode =
      ByteString -> ByteString -> ByteString
LazyByteString.append ByteString
prefix
        (ByteString -> ByteString)
-> (Key a -> ByteString) -> Key a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LazyByteString.reverse
        (ByteString -> ByteString)
-> (Key a -> ByteString) -> Key a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LazyByteString.fromStrict
        (ByteString -> ByteString)
-> (Key a -> ByteString) -> Key a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key a -> ByteString
forall a. IsEncoding a => a -> ByteString
Sodium.encode


decode :: (CryptoNumber a, MonadFail m) => ByteString.ByteString -> m (Key a)
decode :: ByteString -> m (Key a)
decode ByteString
bytes =
  case ByteString -> Maybe a
forall a. IsEncoding a => ByteString -> Maybe a
Sodium.decode ByteString
bytes of
    Just a
key -> Key a -> m (Key a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Key a -> m (Key a)) -> Key a -> m (Key a)
forall a b. (a -> b) -> a -> b
$ a -> Key a
forall a. a -> Key a
Key a
key
    Maybe a
Nothing  -> String -> m (Key a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unable to decode ByteString to Key"


instance CryptoNumber a => Binary (Key a) where
  put :: Key a -> Put
put (Key a
key) =
    ByteString -> Put
Binary.putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. IsEncoding a => a -> ByteString
Sodium.encode a
key

  get :: Get (Key a)
get = do
    ByteString
bytes <- Int -> Get ByteString
Binary.getByteString (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Proxy a -> Int
forall a. CryptoNumber a => Proxy a -> Int
encodedByteSize (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
    ByteString -> Get (Key a)
forall a (m :: * -> *).
(CryptoNumber a, MonadFail m) =>
ByteString -> m (Key a)
decode ByteString
bytes


instance CryptoNumber a => Show (Key a) where
  show :: Key a -> String
show (Key a
key) = ByteString -> String
forall a. Show a => a -> String
show (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Base16.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. IsEncoding a => a -> ByteString
Sodium.encode a
key

instance CryptoNumber a => Read (Key a) where
  readPrec :: ReadPrec (Key a)
readPrec = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (ByteString, ByteString)
Base16.decode (ByteString -> ByteString)
-> ReadPrec ByteString -> ReadPrec ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec ByteString
forall a. Read a => ReadPrec a
readPrec ReadPrec ByteString
-> (ByteString -> ReadPrec (Key a)) -> ReadPrec (Key a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> ReadPrec (Key a)
forall a (m :: * -> *).
(CryptoNumber a, MonadFail m) =>
ByteString -> m (Key a)
decode

instance CryptoNumber a => MessagePack (Key a) where
  toObject :: Key a -> Object
toObject = ByteString -> Object
forall a. MessagePack a => a -> Object
toObject (ByteString -> Object) -> (Key a -> ByteString) -> Key a -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key a -> ByteString
forall a. IsEncoding a => a -> ByteString
Sodium.encode
  fromObject :: Object -> m (Key a)
fromObject = Object -> m ByteString
forall a (m :: * -> *).
(MessagePack a, Applicative m, Monad m, MonadFail m) =>
Object -> m a
fromObject (Object -> m ByteString)
-> (ByteString -> m (Key a)) -> Object -> m (Key a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> m (Key a)
forall a (m :: * -> *).
(CryptoNumber a, MonadFail m) =>
ByteString -> m (Key a)
decode


{-------------------------------------------------------------------------------
 -
 - :: Tests.
 -
 ------------------------------------------------------------------------------}


instance CryptoNumber a => Arbitrary (Key a) where
  arbitrary :: Gen (Key a)
arbitrary = do
    ByteString
bytes <- ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> ByteString
ByteString.pack (Gen [Word8] -> Gen ByteString) -> Gen [Word8] -> Gen ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Gen [Word8]
forall a. Arbitrary a => Int -> Gen [a]
Arbitrary.vector (Int -> Gen [Word8]) -> Int -> Gen [Word8]
forall a b. (a -> b) -> a -> b
$ Proxy a -> Int
forall a. CryptoNumber a => Proxy a -> Int
encodedByteSize (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
    case ByteString -> Maybe a
forall a. IsEncoding a => ByteString -> Maybe a
Sodium.decode ByteString
bytes of
      Just a
key -> Key a -> Gen (Key a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Key a -> Gen (Key a)) -> Key a -> Gen (Key a)
forall a b. (a -> b) -> a -> b
$ a -> Key a
forall a. a -> Key a
Key a
key
      Maybe a
Nothing  -> String -> Gen (Key a)
forall a. HasCallStack => String -> a
error String
"unable to decode ByteString to Key"
\end{code}