diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..d4b512c --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Rémi (c) 2017 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Rémi nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/README.md b/README.md new file mode 100644 index 0000000..51766e7 --- /dev/null +++ b/README.md @@ -0,0 +1 @@ +# hcryptopals diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 0000000..0574645 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Lib + +main :: IO () +main = print $ hex2base64 "49276d206b696c6c696e6720796f757220627261696e206c696b65206120706f69736f6e6f7573206d757368726f6f6d" diff --git a/benchmark/Main.hs b/benchmark/Main.hs new file mode 100644 index 0000000..6361363 --- /dev/null +++ b/benchmark/Main.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE OverloadedStrings #-} + +import qualified Data.ByteString.Lazy.Char8 as B +import Criterion.Main +import Lib + + +hexInf :: String +hexInf = cycle $ ['0'..'9'] ++ ['A'..'F'] +hex1k :: B.ByteString +hex1k = B.pack $! take 1000 hexInf +hex10k :: B.ByteString +hex10k = B.pack $! take 10000 hexInf +hex100k :: B.ByteString +hex100k = B.pack $! take 100000 hexInf +hex1M :: B.ByteString +hex1M = B.pack $! take 1000000 hexInf +hex10M :: B.ByteString +hex10M = B.pack $! take 10000000 hexInf + + +main :: IO () +main = defaultMain + [ bgroup "hex2base64" + [ bench "1k" $ nf hex2base64 hex1k + , bench "10k" $ nf hex2base64 hex10k + , bench "100k" $ nf hex2base64 hex100k + , bench "1M" $ nf hex2base64 hex1M + , bench "10M" $ nf hex2base64 hex10M + ] + ] diff --git a/hcryptopals.cabal b/hcryptopals.cabal new file mode 100644 index 0000000..a2ed2cc --- /dev/null +++ b/hcryptopals.cabal @@ -0,0 +1,60 @@ +name: hcryptopals +version: 0.1.0.0 +-- synopsis: +-- description: +homepage: https://github.com/remusao/hcryptopals#readme +license: BSD3 +license-file: LICENSE +author: Rémi +maintainer: remi@cliqz.com +copyright: GPLv3 +category: TODO +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Lib + other-modules: Crypto.Pals.Encoding + , Crypto.Pals.BitStream + build-depends: base >= 4.7 && < 5 + , bytestring + , vector + ghc-options: -Wall -O2 + default-language: Haskell2010 + +executable hcryptopals-exe + hs-source-dirs: app + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , hcryptopals + default-language: Haskell2010 + +test-suite hcryptopals-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , hcryptopals + , hedgehog + , bytestring + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +benchmark hcryptopals-benchmarks + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: benchmark + ghc-options: -Wall -O2 -rtsopts -threaded -with-rtsopts=-N + build-depends: base + , hcryptopals + , bytestring + , criterion + default-language: Haskell2010 + + +source-repository head + type: git + location: https://github.com/remusao/hcryptopals diff --git a/src/Crypto/Pals/BitStream.hs b/src/Crypto/Pals/BitStream.hs new file mode 100644 index 0000000..ec8e7bf --- /dev/null +++ b/src/Crypto/Pals/BitStream.hs @@ -0,0 +1,67 @@ + +module Crypto.Pals.BitStream where + + +import Data.Bits ((.|.), shiftL, shiftR, xor, testBit, clearBit) +import Data.Word + +import qualified Data.ByteString.Lazy as BS + + +getFirstNBits :: Int -> BitChunk -> (Word8, BitChunk) +getFirstNBits n (BitChunk s b) = (left, BitChunk (s - n) right) + where + left = b `shiftR` (s - n) + right = (left `shiftL` (s - n)) `xor` b + + +-- | Get @n bits from the BitStream given as argument +getNextBits :: Int -> BitStream -> Maybe (Word8, BitStream) +getNextBits _ [] = Nothing +getNextBits n (chunk@(BitChunk s b):xs) + | s == n = Just (b, xs) + | s >= n = + let (left, right) = getFirstNBits n chunk + in Just (left, right : xs) + | otherwise = + case getNextBits (n - s) xs of + Nothing -> Nothing -- There are not enough bits remaining + Just (left, remaining) -> Just ((b `shiftL` (n - s)) .|. left, remaining) + + +groupByN :: Int -> BitStream -> [Word8] +groupByN _ [] = [] +groupByN n xs = + case getNextBits n xs of + Just (chunk, remaining) -> + chunk : groupByN n remaining + Nothing -> -- We are missing a few bits to form a complete chunk here + let remainingBits = getStreamSize xs + in groupByN remainingBits xs + + +-- BitChunk contains maximum 8 bits +data BitChunk = BitChunk + { size :: Int + , getBits :: Word8 + } deriving (Show) + +type BitStream = [BitChunk] + + +bytes :: BitStream -> BS.ByteString +bytes = BS.pack . groupByN 8 + +bits :: BS.ByteString -> BitStream +bits = map (BitChunk 8) . BS.unpack + +toList :: BitStream -> [Bool] +toList = concatMap chunkToBits + where + chunkToBits :: BitChunk -> [Bool] + chunkToBits (BitChunk 0 _) = [] + chunkToBits (BitChunk n b) = testBit b (n - 1) : chunkToBits (BitChunk (n - 1) (clearBit b (n - 1))) + + +getStreamSize :: BitStream -> Int +getStreamSize = sum . map size diff --git a/src/Crypto/Pals/Encoding.hs b/src/Crypto/Pals/Encoding.hs new file mode 100644 index 0000000..8deb8d7 --- /dev/null +++ b/src/Crypto/Pals/Encoding.hs @@ -0,0 +1,95 @@ +module Crypto.Pals.Encoding where + +import Data.List (elemIndex) +import Data.Char (chr, ord) +import Data.Word + +import qualified Data.ByteString.Lazy as B +import qualified Data.Vector.Unboxed as VU +import qualified Data.Vector as V + +import Crypto.Pals.BitStream + + +generateBytesToBitsTable :: String -> Int -> V.Vector BitChunk +generateBytesToBitsTable symbols padding = V.generate 127 gen + where + gen i = + case chr i `elemIndex` symbols of + Just n -> BitChunk padding (fromIntegral n) + Nothing -> BitChunk 0 0 + + +generateBitsToBytesTable :: String -> VU.Vector Word8 +generateBitsToBytesTable = VU.fromList . map (fromIntegral . ord) + + +toBits :: B.ByteString -> V.Vector BitChunk -> BitStream +toBits str fromBase = map ((V.!) fromBase . fromIntegral) . B.unpack $ str + + +fromBits :: BitStream -> Int -> VU.Vector Word8 -> B.ByteString +fromBits stream n toBase = B.pack . map ((VU.!) toBase . fromIntegral) $ chunks + where + chunks = groupByN n stream + + +-- | Hex to/from bits +-- + +newtype Hex = Hex B.ByteString + deriving (Show, Eq) + +hexSymbols :: String +hexSymbols = ['0'..'9'] ++ ['A'..'F'] + +hexToBits :: B.ByteString -> BitStream +hexToBits bs = toBits bs fromHex + where + fromHex = generateBytesToBitsTable hexSymbols 4 + +bitsToHex :: BitStream -> B.ByteString +bitsToHex stream = fromBits stream 4 toHex + where + toHex = generateBitsToBytesTable hexSymbols + +hex :: B.ByteString -> Hex +hex = Hex . bitsToHex . bits + +unhex :: Hex -> B.ByteString +unhex (Hex bs) = bytes . hexToBits $ bs + +-- | Base64 to/from bits +-- + +newtype B64 = B64 B.ByteString + deriving (Show, Eq) + + +b64Symbols :: String +b64Symbols = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ ['+', '/'] + + +b64ToBits :: B.ByteString -> BitStream +b64ToBits bs = toBits bs fromB64 + where + fromB64 = generateBytesToBitsTable b64Symbols 6 + +bitsToB64 :: BitStream -> B.ByteString +bitsToB64 stream = fromBits stream 6 toB64 + where + toB64 = generateBitsToBytesTable b64Symbols + + +b64 :: B.ByteString -> B64 +b64 = B64 . bitsToB64 . bits + +unb64 :: B64 -> B.ByteString +unb64 (B64 bs) = bytes . b64ToBits $ bs + + +-- | Direct convertion from hex to base64 +-- + +hex2base64 :: B.ByteString -> B.ByteString +hex2base64 str = bitsToB64 . hexToBits $! str diff --git a/src/Lib.hs b/src/Lib.hs new file mode 100644 index 0000000..989cd05 --- /dev/null +++ b/src/Lib.hs @@ -0,0 +1,7 @@ +module Lib + ( module Crypto.Pals.Encoding + , module Crypto.Pals.BitStream + ) where + +import Crypto.Pals.Encoding +import Crypto.Pals.BitStream diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..8bb3a6a --- /dev/null +++ b/stack.yaml @@ -0,0 +1,67 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# http://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# resolver: ghcjs-0.1.0_ghc-7.10.2 +# resolver: +# name: custom-snapshot +# location: "./custom-snapshot.yaml" +resolver: lts-8.18 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# - location: +# git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# extra-dep: true +# subdirs: +# - auto-update +# - wai +# +# A package marked 'extra-dep: true' will only be built if demanded by a +# non-dependency (i.e. a user package), and its test suites and benchmarks +# will not be run. This is useful for tweaking upstream packages. +packages: +- '.' +# Dependency packages to be pulled from upstream that are not in the resolver +# (e.g., acme-missiles-0.3) +extra-deps: +- hedgehog-0.3 + +# Override default flag values for local packages and extra-deps +flags: {} + +# Extra package databases containing global packages +extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=1.4" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 index 0000000..38a230a --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE TemplateHaskell #-} + +import Data.Char +import Data.Word + +import Hedgehog +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range + +import qualified Data.ByteString.Lazy as B + +import Lib + + +symbolsToWord8 :: String -> [Word8] +symbolsToWord8 = map (fromIntegral . ord) + + +forAllB64 = forAll $ + Gen.list (Range.linear 1 100) (Gen.element $ symbolsToWord8 b64Symbols) + where + b64Symbols = ['0'..'9'] ++ ['A'..'Z'] ++ ['a'..'z'] ++ ['/', '+'] + + +forAllHex = forAll $ + Gen.filter (\hex -> length hex `mod` 6 == 0) $ + Gen.list (Range.linear 1 100) (Gen.element $ symbolsToWord8 hexSymbols) + where + hexSymbols = ['0'..'9'] ++ ['A'..'F'] + + +prop_groupByN :: Property +prop_groupByN = + property $ do + n <- forAll $ Gen.int (Range.linear 1 8) + words <- + forAll $ + Gen.filter (\words -> length words `mod` (n * 8) == 0) $ + Gen.list (Range.linear 1 100) (Gen.word8 $ Range.linear 0 255) + + let bitStream = map (BitChunk 8) words + let groups = map (BitChunk n) $ groupByN n bitStream + toList groups === toList bitStream + + +prop_hex :: Property +prop_hex = + property $ do + hex <- forAllHex + let packed = B.pack hex + packed === (bitsToHex . hexToBits $ packed) + + +prop_base64 :: Property +prop_base64 = + property $ do + b64 <- forAllB64 + let packed = B.pack b64 + packed === (bitsToB64 . b64ToBits $ packed) + + +prop_hex2b64 :: Property +prop_hex2b64 = + property $ do + hex <- forAllHex + let packed = B.pack hex + let b64 = hex2base64 packed + let bits = b64ToBits b64 + let hex2 = bitsToHex bits + packed === hex2 + + +main :: IO Bool +main = + checkParallel $$(discover)