-- |
-- Module      : Crypto.Longshot.Internal
-- License     : MIT
-- Maintainer  : Francis Lim <thyeem@gmail.com>
-- Stability   : experimental
-- Portability : unknown
--
module Crypto.Longshot.Internal
  ( bruteforce
  , bruteforceDeep
  , bruteforcePar
  , (<%>)
  , image
  , byteChars
  , bytePrefixes
  )
where

import           Control.Monad                  ( replicateM )
import           Control.Applicative            ( (<|>)
                                                , empty
                                                )
import           Control.Parallel               ( par
                                                , pseq
                                                )
import           Control.DeepSeq                ( NFData
                                                , force
                                                )
import           Data.Foldable                  ( foldl' )
import           Data.ByteString                ( ByteString )
import qualified Data.ByteString.Char8         as C
import qualified Data.ByteString.Base16        as H
import           Crypto.Longshot.Hasher
import           Crypto.Longshot.TH
import           Crypto.Longshot.Const

-- | Each bruteforceN declaration: generating code through splicing.
-- Number of functions declared == 'maxNumBind'
--
$( p -> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce17 :: [ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce16 :: [ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce15 :: [ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce14 :: [ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce13 :: [ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce12 :: [ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce11 :: [ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce10 :: [ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce9 :: [ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce8 :: [ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce7 :: [ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce6 :: [ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce5 :: [ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce4 :: [ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce3 :: [ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce2 :: [ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce1 :: [ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce0 :: p -> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
funcGenerator )

-- | Brute-force search only for a given exact length
--
-- @
-- +----------+----------------------------------------------------------------------+
-- |     size | Preimage length to search                                            |
-- +----------+----------------------------------------------------------------------+
-- |    chars | Given character set like "0123456789"                                |
-- +----------+----------------------------------------------------------------------+
-- |      hex | Given hex-string like "17da1ae431f965d839ec8eb93087fb2b"             |
-- +----------+----------------------------------------------------------------------+
-- |   hasher | Hash functions in 'Hasher' module. Get it using 'getHasher'          |
-- +----------+----------------------------------------------------------------------+
-- |  numBind | Number of bound variables defined by search length and prefix size   |
-- +----------+----------------------------------------------------------------------+
-- |   runPar | A partially applied function for parallel execution                  |
-- +----------+----------------------------------------------------------------------+
-- | prefixes | All possible combinations of given prefix characters.                |
-- |          | The search space is equally partitioned based on these prefixes.     |
-- |          | length of prefixes == number of sparks                               |
-- +----------+----------------------------------------------------------------------+
-- @
--
bruteforce :: Int -> String -> String -> Hasher -> Maybe String
bruteforce :: Int -> [Char] -> [Char] -> Hasher -> Maybe [Char]
bruteforce Int
size [Char]
chars [Char]
hex Hasher
hasher = Maybe [Char]
found
 where
  found :: Maybe [Char]
found  = (Maybe [Char] -> Maybe [Char] -> Maybe [Char])
-> Maybe [Char] -> [Maybe [Char]] -> Maybe [Char]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Maybe [Char] -> Maybe [Char] -> Maybe [Char]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) Maybe [Char]
forall (f :: * -> *) a. Alternative f => f a
empty (ByteString -> Maybe [Char]
runPar (ByteString -> Maybe [Char]) -> [ByteString] -> [Maybe [Char]]
forall a b. (NFData a, NFData b) => (a -> b) -> [a] -> [b]
<%> [ByteString]
prefixes)
  runPar :: ByteString -> Maybe [Char]
runPar = Int
-> [ByteString]
-> ByteString
-> Hasher
-> ByteString
-> Maybe [Char]
bruteforcePar Int
numBind ([Char] -> [ByteString]
byteChars [Char]
chars) ([Char] -> ByteString
image [Char]
hex) Hasher
hasher
  numPrefix :: Int
numPrefix | Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
defNumPrefix = Int
1
            | Bool
otherwise           = Int
defNumPrefix
  numBind :: Int
numBind  = Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numPrefix
  prefixes :: [ByteString]
prefixes = Int -> [Char] -> [ByteString]
bytePrefixes Int
numPrefix [Char]
chars

-- | Pick up an appropriate search function
--
-- Returns a partial application corresponding to the given numBind
--
bruteforcePar
  :: Int -> [ByteString] -> ByteString -> Hasher -> ByteString -> Maybe String
bruteforcePar :: Int
-> [ByteString]
-> ByteString
-> Hasher
-> ByteString
-> Maybe [Char]
bruteforcePar Int
numBind
  | Int
numBind Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
0 .. Int
maxNumBind] = $( [[ByteString]
 -> ByteString -> Hasher -> ByteString -> Maybe [Char]]
[ByteString] -> ByteString -> Hasher -> ByteString -> Maybe [Char]
forall a.
Eq a =>
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
forall a p.
Eq a =>
p -> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce17 :: forall a.
Eq a =>
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce16 :: forall a.
Eq a =>
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce15 :: forall a.
Eq a =>
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce14 :: forall a.
Eq a =>
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce13 :: forall a.
Eq a =>
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce12 :: forall a.
Eq a =>
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce11 :: forall a.
Eq a =>
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce10 :: forall a.
Eq a =>
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce9 :: forall a.
Eq a =>
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce8 :: forall a.
Eq a =>
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce7 :: forall a.
Eq a =>
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce6 :: forall a.
Eq a =>
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce5 :: forall a.
Eq a =>
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce4 :: forall a.
Eq a =>
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce3 :: forall a.
Eq a =>
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce2 :: forall a.
Eq a =>
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce1 :: forall a.
Eq a =>
[ByteString]
-> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
bruteforce0 :: forall a p.
Eq a =>
p -> a -> (ByteString -> a) -> ByteString -> Maybe [Char]
funcList ) [[ByteString]
 -> ByteString -> Hasher -> ByteString -> Maybe [Char]]
-> Int
-> [ByteString]
-> ByteString
-> Hasher
-> ByteString
-> Maybe [Char]
forall a. [a] -> Int -> a
!! Int
numBind
  | Bool
otherwise = [Char]
-> [ByteString]
-> ByteString
-> Hasher
-> ByteString
-> Maybe [Char]
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Not available search length"

-- | Incrementally searches without knowing the exact length of search
--
-- See the 'bruteforce' function for the arguments used
--
bruteforceDeep :: String -> String -> Hasher -> Maybe String
bruteforceDeep :: [Char] -> [Char] -> Hasher -> Maybe [Char]
bruteforceDeep [Char]
chars [Char]
hex Hasher
hasher = (Maybe [Char] -> Maybe [Char] -> Maybe [Char])
-> Maybe [Char] -> [Maybe [Char]] -> Maybe [Char]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Maybe [Char] -> Maybe [Char] -> Maybe [Char]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) Maybe [Char]
forall (f :: * -> *) a. Alternative f => f a
empty [Maybe [Char]]
found
 where
  found :: [Maybe [Char]]
found = [Char] -> [Char] -> Hasher -> Int -> Maybe [Char]
deep [Char]
chars [Char]
hex Hasher
hasher (Int -> Maybe [Char]) -> [Int] -> [Maybe [Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1 .. Int
limitSearchLength]
  deep :: [Char] -> [Char] -> Hasher -> Int -> Maybe [Char]
deep [Char]
a [Char]
b Hasher
c Int
d = Int -> [Char] -> [Char] -> Hasher -> Maybe [Char]
bruteforce Int
d [Char]
a [Char]
b Hasher
c

-- | Parallel map using deepseq, par and pseq
--
-- Type of any argument in this map should be an instance of 'NFData'.
--
(<%>) :: (NFData a, NFData b) => (a -> b) -> [a] -> [b]
a -> b
f <%> :: (a -> b) -> [a] -> [b]
<%> []       = []
a -> b
f <%> (a
x : [a]
xs) = b
y b -> [b] -> [b]
forall a b. a -> b -> b
`par` [b]
ys [b] -> [b] -> [b]
forall a b. a -> b -> b
`pseq` (b
y b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
ys) where
  y :: b
y  = b -> b
forall a. NFData a => a -> a
force (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
  ys :: [b]
ys = a -> b
f (a -> b) -> [a] -> [b]
forall a b. (NFData a, NFData b) => (a -> b) -> [a] -> [b]
<%> [a]
xs

-- | Image bytestring: target hash value to find
image :: String -> ByteString
image :: [Char] -> ByteString
image = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> ([Char] -> (ByteString, ByteString)) -> [Char] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (ByteString, ByteString)
H.decode (ByteString -> (ByteString, ByteString))
-> ([Char] -> ByteString) -> [Char] -> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
C.pack

-- | Bytestring usable for preimage
byteChars :: String -> [ByteString]
byteChars :: [Char] -> [ByteString]
byteChars [Char]
chars = [Char] -> ByteString
C.pack ([Char] -> ByteString) -> (Char -> [Char]) -> Char -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: []) (Char -> ByteString) -> [Char] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
chars

-- | Combination of prefixes possible: size of @(length of chars) ^ (numPrefix)@
bytePrefixes :: Int -> String -> [ByteString]
bytePrefixes :: Int -> [Char] -> [ByteString]
bytePrefixes Int
numPrefix [Char]
chars = [Char] -> ByteString
C.pack ([Char] -> ByteString) -> [[Char]] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Char] -> [[Char]]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
numPrefix [Char]
chars