{-# LANGUAGE PatternSynonyms #-}

-- | @scrypt@-related types and utilities.
module Crypto.Age.Scrypt
  ( -- * Passphrase
    Passphrase (..)

    -- * Salt
  , Salt (Salt)
  , bytesToSalt
  , saltToBytes

    -- * Work factor
  , WorkFactor (WorkFactor)
  , unWorkFactor
  , mkWorkFactor
  , workFactorBuilder
  , workFactorParser
  ) where

import Control.Monad ( when )
import Data.Attoparsec.ByteString ( Parser, endOfInput, peekWord8' )
import Data.Attoparsec.ByteString.Char8 ( decimal )
import Data.ByteArray ( ScrubbedBytes )
import Data.ByteString ( ByteString )
import qualified Data.ByteString as BS
import Data.ByteString.Builder ( Builder )
import qualified Data.ByteString.Builder as Builder
import Data.Word ( Word8 )
import Prelude

-- | @scrypt@ passphrase.
--
-- Note that this type's 'Eq' instance performs a constant-time equality
-- check.
newtype Passphrase = Passphrase
  { Passphrase -> ScrubbedBytes
unPassphrase :: ScrubbedBytes }
  deriving newtype (Int -> Passphrase -> ShowS
[Passphrase] -> ShowS
Passphrase -> String
(Int -> Passphrase -> ShowS)
-> (Passphrase -> String)
-> ([Passphrase] -> ShowS)
-> Show Passphrase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Passphrase -> ShowS
showsPrec :: Int -> Passphrase -> ShowS
$cshow :: Passphrase -> String
show :: Passphrase -> String
$cshowList :: [Passphrase] -> ShowS
showList :: [Passphrase] -> ShowS
Show, Passphrase -> Passphrase -> Bool
(Passphrase -> Passphrase -> Bool)
-> (Passphrase -> Passphrase -> Bool) -> Eq Passphrase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Passphrase -> Passphrase -> Bool
== :: Passphrase -> Passphrase -> Bool
$c/= :: Passphrase -> Passphrase -> Bool
/= :: Passphrase -> Passphrase -> Bool
Eq)

-- | @scrypt@ salt.
newtype Salt = MkSalt
  { Salt -> ByteString
unSalt :: ByteString }
  deriving newtype (Int -> Salt -> ShowS
[Salt] -> ShowS
Salt -> String
(Int -> Salt -> ShowS)
-> (Salt -> String) -> ([Salt] -> ShowS) -> Show Salt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Salt -> ShowS
showsPrec :: Int -> Salt -> ShowS
$cshow :: Salt -> String
show :: Salt -> String
$cshowList :: [Salt] -> ShowS
showList :: [Salt] -> ShowS
Show, Salt -> Salt -> Bool
(Salt -> Salt -> Bool) -> (Salt -> Salt -> Bool) -> Eq Salt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Salt -> Salt -> Bool
== :: Salt -> Salt -> Bool
$c/= :: Salt -> Salt -> Bool
/= :: Salt -> Salt -> Bool
Eq)

pattern Salt :: ByteString -> Salt
pattern $mSalt :: forall {r}. Salt -> (ByteString -> r) -> ((# #) -> r) -> r
Salt bs <- MkSalt bs

{-# COMPLETE Salt #-}

-- | Construct a 'Salt' from bytes.
--
-- If the provided byte string does not have a length of 16 (128 bits),
-- 'Nothing' is returned.
bytesToSalt :: ByteString -> Maybe Salt
bytesToSalt :: ByteString -> Maybe Salt
bytesToSalt ByteString
bs
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
16 = Salt -> Maybe Salt
forall a. a -> Maybe a
Just (ByteString -> Salt
MkSalt ByteString
bs)
  | Bool
otherwise = Maybe Salt
forall a. Maybe a
Nothing

-- | Get the raw bytes associated with a 'Salt'.
saltToBytes :: Salt -> ByteString
saltToBytes :: Salt -> ByteString
saltToBytes = Salt -> ByteString
unSalt

-- | Minimum work factor (@1@).
minWorkFactor :: Word8
minWorkFactor :: Word8
minWorkFactor = Word8
1

-- | Maximum work factor (@64@).
maxWorkFactor :: Word8
maxWorkFactor :: Word8
maxWorkFactor = Word8
64

-- | @scrypt@ \"work factor\" (as it is referred to in the age specification).
--
-- This value is used in calculating the
-- [@scrypt@ cost parameter (also referred to as @N@)](https://www.rfc-editor.org/rfc/rfc7914#section-2):
--
-- > N = 2 ^ work_factor
newtype WorkFactor = MkWorkFactor
  { WorkFactor -> Word8
unWorkFactor :: Word8 }
  deriving newtype (Int -> WorkFactor -> ShowS
[WorkFactor] -> ShowS
WorkFactor -> String
(Int -> WorkFactor -> ShowS)
-> (WorkFactor -> String)
-> ([WorkFactor] -> ShowS)
-> Show WorkFactor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkFactor -> ShowS
showsPrec :: Int -> WorkFactor -> ShowS
$cshow :: WorkFactor -> String
show :: WorkFactor -> String
$cshowList :: [WorkFactor] -> ShowS
showList :: [WorkFactor] -> ShowS
Show, WorkFactor -> WorkFactor -> Bool
(WorkFactor -> WorkFactor -> Bool)
-> (WorkFactor -> WorkFactor -> Bool) -> Eq WorkFactor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WorkFactor -> WorkFactor -> Bool
== :: WorkFactor -> WorkFactor -> Bool
$c/= :: WorkFactor -> WorkFactor -> Bool
/= :: WorkFactor -> WorkFactor -> Bool
Eq)

instance Bounded WorkFactor where
  minBound :: WorkFactor
minBound = Word8 -> WorkFactor
MkWorkFactor Word8
minWorkFactor
  maxBound :: WorkFactor
maxBound = Word8 -> WorkFactor
MkWorkFactor Word8
maxWorkFactor

pattern WorkFactor :: Word8 -> WorkFactor
pattern $mWorkFactor :: forall {r}. WorkFactor -> (Word8 -> r) -> ((# #) -> r) -> r
WorkFactor w8 <- MkWorkFactor w8

{-# COMPLETE WorkFactor #-}

-- | Construct a 'WorkFactor' value.
--
-- If the provided value is @0@ or greater than @64@, this function will return
-- 'Nothing'.
mkWorkFactor :: Word8 -> Maybe WorkFactor
mkWorkFactor :: Word8 -> Maybe WorkFactor
mkWorkFactor Word8
w8
  | Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
minWorkFactor Bool -> Bool -> Bool
&& Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
maxWorkFactor = WorkFactor -> Maybe WorkFactor
forall a. a -> Maybe a
Just (Word8 -> WorkFactor
MkWorkFactor Word8
w8)
  | Bool
otherwise = Maybe WorkFactor
forall a. Maybe a
Nothing

-- | 'WorkFactor' encoder.
workFactorBuilder :: WorkFactor -> Builder
workFactorBuilder :: WorkFactor -> Builder
workFactorBuilder = Word8 -> Builder
Builder.word8Dec (Word8 -> Builder)
-> (WorkFactor -> Word8) -> WorkFactor -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkFactor -> Word8
unWorkFactor

-- | 'WorkFactor' parser.
workFactorParser :: Parser WorkFactor
workFactorParser :: Parser WorkFactor
workFactorParser = do
  Word8
firstByte <- Parser Word8
peekWord8'
  Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
firstByte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x30) (Parser ByteString () -> Parser ByteString ())
-> Parser ByteString () -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$
    -- Leading zeroes are disallowed
    String -> Parser ByteString ()
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected digit from 1 to 9"

  Integer
parsedDigits <- Parser Integer
forall a. Integral a => Parser a
decimal Parser Integer -> Parser ByteString () -> Parser Integer
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput :: Parser Integer
  Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
parsedDigits Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0) (Parser ByteString () -> Parser ByteString ())
-> Parser ByteString () -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$
    String -> Parser ByteString ()
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected integer greater than 0"
  Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
parsedDigits Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
64) (Parser ByteString () -> Parser ByteString ())
-> Parser ByteString () -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$
    String -> Parser ByteString ()
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected integer less than 65"
  WorkFactor -> Parser WorkFactor
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WorkFactor -> Parser WorkFactor)
-> WorkFactor -> Parser WorkFactor
forall a b. (a -> b) -> a -> b
$ Word8 -> WorkFactor
MkWorkFactor (Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
parsedDigits)