{-# LANGUAGE OverloadedStrings #-}

module Authorize.Macaroon.Crypto (
    createSignature,
    updateSignature,
    encryptKey,
    decryptKey,
    bindForRequest,
    deriveKey,
) where

import Authorize.Macaroon.Types (
    Key (..),
    KeyId (..),
    MacaroonId (..),
    Signature (..),
 )
import Crypto.Hash (SHA256)
import Crypto.MAC.HMAC (HMAC, hmac)
import Crypto.Saltine.Class qualified as Nacl
import Crypto.Saltine.Core.SecretBox (
    newNonce,
    secretbox,
    secretboxOpen,
 )
import Crypto.Saltine.Internal.SecretBox (secretbox_noncebytes)
import Data.ByteArray (
    ByteArray,
    ByteArrayAccess,
    convert,
 )
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS

createSignature :: Key -> MacaroonId -> Signature
createSignature :: Key -> MacaroonId -> Signature
createSignature Key
k MacaroonId
m = ByteString -> Signature
Signature (ByteString -> Signature) -> ByteString -> Signature
forall a b. (a -> b) -> a -> b
$ Key -> MacaroonId -> ByteString
forall k b c.
(ByteArrayAccess k, ByteArrayAccess b, ByteArray c) =>
k -> b -> c
keyedHash Key
k MacaroonId
m

updateSignature :: Signature -> Maybe KeyId -> ByteString -> Signature
updateSignature :: Signature -> Maybe KeyId -> ByteString -> Signature
updateSignature Signature
s Maybe KeyId
kid ByteString
c = ByteString -> Signature
Signature (ByteString -> Signature) -> ByteString -> Signature
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString)
-> (KeyId -> ByteString -> ByteString)
-> Maybe KeyId
-> ByteString
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Signature -> ByteString -> ByteString
forall k b c.
(ByteArrayAccess k, ByteArrayAccess b, ByteArray c) =>
k -> b -> c
keyedHash Signature
s) (Signature -> KeyId -> ByteString -> ByteString
forall k b c d.
(ByteArrayAccess k, ByteArrayAccess b, ByteArrayAccess c,
 ByteArray d, Monoid d) =>
k -> b -> c -> d
keyedPairHash Signature
s) Maybe KeyId
kid ByteString
c

encryptKey :: Signature -> Key -> IO KeyId
encryptKey :: Signature -> Key -> IO KeyId
encryptKey (Signature ByteString
s) (Key ScrubbedBytes
k) = do
    Nonce
n <- IO Nonce
newNonce
    Key
key <- IO Key -> (Key -> IO Key) -> Maybe Key -> IO Key
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO Key
forall {a}. a
err Key -> IO Key
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Key -> IO Key) -> Maybe Key -> IO Key
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Key
forall a. IsEncoding a => ByteString -> Maybe a
Nacl.decode ByteString
s
    KeyId -> IO KeyId
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyId -> IO KeyId)
-> (ByteString -> KeyId) -> ByteString -> IO KeyId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> KeyId
KeyId (ByteString -> IO KeyId) -> ByteString -> IO KeyId
forall a b. (a -> b) -> a -> b
$ Nonce -> ByteString
forall a. IsEncoding a => a -> ByteString
Nacl.encode Nonce
n ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Key -> Nonce -> ByteString -> ByteString
secretbox Key
key Nonce
n (ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert ScrubbedBytes
k)
  where
    err :: a
err = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Unable to decode key"

decryptKey :: Signature -> KeyId -> Maybe Key
decryptKey :: Signature -> KeyId -> Maybe Key
decryptKey (Signature ByteString
s) (KeyId ByteString
kid) = do
    Nonce
n <- ByteString -> Maybe Nonce
forall a. IsEncoding a => ByteString -> Maybe a
Nacl.decode ByteString
nonceBytes
    Key
key <- ByteString -> Maybe Key
forall a. IsEncoding a => ByteString -> Maybe a
Nacl.decode ByteString
s
    ScrubbedBytes -> Key
Key (ScrubbedBytes -> Key)
-> (ByteString -> ScrubbedBytes) -> ByteString -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (ByteString -> Key) -> Maybe ByteString -> Maybe Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Nonce -> ByteString -> Maybe ByteString
secretboxOpen Key
key Nonce
n ByteString
ct
  where
    (ByteString
nonceBytes, ByteString
ct) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
secretbox_noncebytes ByteString
kid

bindForRequest :: Signature -> Signature -> Signature
bindForRequest :: Signature -> Signature -> Signature
bindForRequest = ByteString -> Signature -> Signature -> Signature
forall k b c d.
(ByteArrayAccess k, ByteArrayAccess b, ByteArrayAccess c,
 ByteArray d, Monoid d) =>
k -> b -> c -> d
keyedPairHash ByteString
zeroKey
  where
    zeroKey :: ByteString
zeroKey = Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
0x0

hmac256 :: (ByteArrayAccess k, ByteArrayAccess x) => k -> x -> HMAC SHA256
hmac256 :: forall k x.
(ByteArrayAccess k, ByteArrayAccess x) =>
k -> x -> HMAC SHA256
hmac256 = k -> x -> HMAC SHA256
forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac

deriveKey :: Key -> Key
deriveKey :: Key -> Key
deriveKey (Key ScrubbedBytes
k) = ScrubbedBytes -> Key
Key (ScrubbedBytes -> Key)
-> (HMAC SHA256 -> ScrubbedBytes) -> HMAC SHA256 -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HMAC SHA256 -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (HMAC SHA256 -> Key) -> HMAC SHA256 -> Key
forall a b. (a -> b) -> a -> b
$ ByteString -> ScrubbedBytes -> HMAC SHA256
forall k x.
(ByteArrayAccess k, ByteArrayAccess x) =>
k -> x -> HMAC SHA256
hmac256 ByteString
tag ScrubbedBytes
k
  where
    tag :: ByteString
    tag :: ByteString
tag = ByteString
"macaroons-key-generator"

keyedHash ::
    (ByteArrayAccess k, ByteArrayAccess b, ByteArray c) =>
    k ->
    b ->
    c
keyedHash :: forall k b c.
(ByteArrayAccess k, ByteArrayAccess b, ByteArray c) =>
k -> b -> c
keyedHash k
k = HMAC SHA256 -> c
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (HMAC SHA256 -> c) -> (b -> HMAC SHA256) -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> b -> HMAC SHA256
forall k x.
(ByteArrayAccess k, ByteArrayAccess x) =>
k -> x -> HMAC SHA256
hmac256 k
k

keyedPairHash ::
    ( ByteArrayAccess k
    , ByteArrayAccess b
    , ByteArrayAccess c
    , ByteArray d
    , Monoid d
    ) =>
    k ->
    b ->
    c ->
    d
keyedPairHash :: forall k b c d.
(ByteArrayAccess k, ByteArrayAccess b, ByteArrayAccess c,
 ByteArray d, Monoid d) =>
k -> b -> c -> d
keyedPairHash k
k b
x c
y =
    k -> ByteString -> d
forall k b c.
(ByteArrayAccess k, ByteArrayAccess b, ByteArray c) =>
k -> b -> c
keyedHash k
k (k -> b -> ByteString
forall k b c.
(ByteArrayAccess k, ByteArrayAccess b, ByteArray c) =>
k -> b -> c
keyedHash k
k b
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> k -> c -> ByteString
forall k b c.
(ByteArrayAccess k, ByteArrayAccess b, ByteArray c) =>
k -> b -> c
keyedHash k
k c
y :: ByteString)