\section{Key}

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

import           Control.Monad                ((>=>))
import           Control.Monad.Validate       (MonadValidate, refute)
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.Core.Sign     as Sodium (Signature)
import qualified Crypto.Saltine.Internal.Box  as Sodium (box_beforenmbytes,
                                                         box_noncebytes,
                                                         box_publickeybytes,
                                                         box_secretkeybytes)
import qualified Crypto.Saltine.Internal.Sign as Sodium (sign_bytes)
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             (DecodeError, MessagePack (..))
import           Data.Proxy                   (Proxy (..))
import           Data.String                  (fromString)
import           Data.Typeable                (Typeable)
import qualified Test.QuickCheck.Arbitrary    as Arbitrary
import           Test.QuickCheck.Arbitrary    (Arbitrary, 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
_ = Int
Sodium.box_publickeybytes }
instance CryptoNumber Sodium.SecretKey   where { encodedByteSize :: proxy SecretKey -> Int
encodedByteSize proxy SecretKey
_ = Int
Sodium.box_secretkeybytes }
instance CryptoNumber Sodium.CombinedKey where { encodedByteSize :: proxy CombinedKey -> Int
encodedByteSize proxy CombinedKey
_ = Int
Sodium.box_beforenmbytes  }
instance CryptoNumber Sodium.Nonce       where { encodedByteSize :: proxy Nonce -> Int
encodedByteSize proxy Nonce
_ = Int
Sodium.box_noncebytes     }
instance CryptoNumber Sodium.Signature   where { encodedByteSize :: proxy Signature -> Int
encodedByteSize proxy Signature
_ = Int
Sodium.sign_bytes         }

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

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
type Signature   = Key Sodium.Signature

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, MonadValidate DecodeError 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  -> DecodeError -> m (Key a)
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute (DecodeError -> m (Key a)) -> DecodeError -> m (Key a)
forall a b. (a -> b) -> a -> b
$ String -> DecodeError
forall a. IsString a => String -> a
fromString (String -> DecodeError) -> String -> DecodeError
forall a b. (a -> b) -> a -> b
$ String
"unable to decode ByteString to Key: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
ByteString.length ByteString
bytes)


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 (proxy :: * -> *). 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, MonadValidate DecodeError m) =>
ByteString -> m (Key a)
decode ByteString
bytes


instance CryptoNumber a => Show (Key a) where
  show :: Key a -> String
show = ByteString -> String
forall a. Show a => a -> String
show (ByteString -> String) -> (Key a -> ByteString) -> Key a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode (ByteString -> ByteString)
-> (Key a -> ByteString) -> Key a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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

instance CryptoNumber a => Read (Key a) where
  readPrec :: ReadPrec (Key a)
readPrec = do
    ByteString
text <- ReadPrec ByteString
forall a. Read a => ReadPrec a
readPrec
    case ByteString -> Either String ByteString
Base16.decode ByteString
text of
      Left String
err -> String -> ReadPrec (Key a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
      Right ByteString
ok -> ByteString -> ReadPrec (Key a)
forall a (m :: * -> *).
(CryptoNumber a, MonadValidate DecodeError m) =>
ByteString -> m (Key a)
decode ByteString
ok

instance CryptoNumber a => MessagePack (Key a) where
  toObject :: Config -> Key a -> Object
toObject Config
cfg = Config -> ByteString -> Object
forall a. MessagePack a => Config -> a -> Object
toObject Config
cfg (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
  fromObjectWith :: Config -> Object -> m (Key a)
fromObjectWith Config
cfg = Config -> Object -> m ByteString
forall a (m :: * -> *).
(MessagePack a, Applicative m, Monad m,
 MonadValidate DecodeError m) =>
Config -> Object -> m a
fromObjectWith Config
cfg (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, MonadValidate DecodeError 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 (proxy :: * -> *). 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}