Implement hex/base64 conversion

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.

README.md

@@ -0,0 +1 @@
+# hcryptopals

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

app/Main.hs

@@ -0,0 +1,8 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Lib
+
+main :: IO ()
+main = print $ hex2base64 "49276d206b696c6c696e6720796f757220627261696e206c696b65206120706f69736f6e6f7573206d757368726f6f6d"

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
+      ]
+  ]

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

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

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

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

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