initial commit

.gitignore

@@ -0,0 +1,5 @@
+*.sw[pon]
+*.hi
+*.o
+.stack-work
+Example

Example.hs

@@ -0,0 +1,163 @@
+import Prelude
+import           System.Environment (getArgs)
+import           Network.Socket hiding (recv)
+import           Network.Socket.ByteString (recv, sendAll)
+import           Control.Concurrent
+import           Control.Concurrent.MVar
+import           Data.Monoid ((<>))
+import           Data.Serialize
+import           Control.Monad.State
+import           Control.Applicative (liftA)
+import           Crypto.Error
+import           Crypto.PubKey.Curve25519
+import           Crypto.Random
+import qualified Data.ByteArray          as BA
+import qualified Data.ByteArray.Encoding as BAE
+import qualified Data.ByteString         as BS
+import qualified Data.ByteString.Char8   as BSC
+
+import Ratchet
+
+data Input =
+    Keyboard BS.ByteString
+  | Wire BS.ByteString
+
+port :: String
+port = "12345"
+
+host :: String
+host = "localhost"
+
+main :: IO ()
+main = do
+  let port = "12345"
+      host = "localhost"
+  arg <- getArgs
+
+  case arg of
+    ["server"] -> server
+    ["client"] -> client
+    _          -> usage
+
+maxSkipMsgs :: MaxSkipped
+maxSkipMsgs = 64
+
+client :: IO ()
+client = withSocketsDo $ do
+  let stateBob   = emptyRatchet maxSkipMsgs
+  (ssk, bobsKeyPair) <- readSharedData
+  mvar <- newEmptyMVar
+  addrinfos <- getAddrInfo Nothing (Just host) (Just port)
+  let serveraddr = head addrinfos
+  conn <- socket (addrFamily serveraddr) Stream defaultProtocol
+  connect conn (addrAddress serveraddr)
+  putStrLn "Connected to server."
+  forkFinally (wireLoop conn mvar) (\_ -> close conn)
+  forkIO $ inpLoop conn mvar
+  evalState' stateBob $ do
+    ratchetInitBob ssk bobsKeyPair
+    handle conn mvar
+
+server :: IO ()
+server = withSocketsDo $ do
+  let maxConnQueue = 1
+      stateAlice = emptyRatchet maxSkipMsgs
+  (ssk, bobsKeyPair) <- readSharedData
+
+  mvar <- newEmptyMVar
+  addrinfos <- getAddrInfo
+               (Just $ defaultHints {addrFlags = [AI_PASSIVE]})
+               Nothing
+               (Just port)
+  let serveraddr = head addrinfos
+  sock <- socket (addrFamily serveraddr) Stream defaultProtocol
+  setSocketOption sock ReuseAddr 1
+  bind sock (addrAddress serveraddr)
+  listen sock maxConnQueue
+
+  putStrLn "Waiting for client to connect..."
+  (conn, _) <- accept sock
+  putStrLn "Client connected."
+  forkFinally (wireLoop conn mvar) (\_ -> close conn)
+  forkIO $ inpLoop conn mvar
+  evalState' stateAlice $ do
+    ratchetInitAlice ssk (pubKey bobsKeyPair)
+    handle conn mvar
+
+handle :: Socket -> MVar Input -> StateT StateRatchet IO ()
+handle conn mvar = do
+  inp <- lift $ takeMVar mvar
+
+  case inp of
+    Keyboard str -> do
+        let adLen = 42
+        ad <- lift $ AssocData <$> getRandomBytes adLen
+        (mh, payload) <- ratchetEncrypt (PlainText $ BA.convert str) ad
+        case payload of
+          Left err ->
+            lift $ print err
+
+          Right cipher -> do
+            let msg = encode (mh, cipher, ad)
+            lift $ sendAll conn msg
+
+    Wire msg -> do
+      case decode msg of
+        Left err ->
+          lift $ putStrLn $ "Could not decode received data: " <> err
+
+        Right (mh, cipher, ad) -> do
+          dec <- ratchetDecrypt mh cipher ad
+          case dec of
+            Left err ->
+              lift $ print err
+
+            Right (PlainText plain) -> do
+              let pre = "\nMessage received: "
+              lift $ putStrLn $ pre <> show plain
+
+  handle conn mvar
+
+inpLoop :: Socket -> MVar Input -> IO ()
+inpLoop conn mvar = do
+  putStr "Type a message: "
+  str <- getLine
+  putMVar mvar $ Keyboard $ BSC.pack str
+
+  inpLoop conn mvar
+
+wireLoop :: Socket -> MVar Input -> IO ()
+wireLoop conn mvar = do
+  bs <- recv conn 1024
+  putMVar mvar $ Wire bs
+
+  wireLoop conn mvar
+
+usage :: IO ()
+usage = putStrLn "stack repl Example.hs \"server\" | \"client\""
+
+-- helper functions
+evalState' :: Monad m => s -> StateT s m a -> m a
+evalState' = flip evalStateT
+
+readSharedData :: IO (SharedSecretKey, DHKeyPair)
+readSharedData = do
+  let extract pub priv = do
+      priv' <- secretKey priv
+      pub'  <- publicKey pub
+      return (priv', pub')
+  let convert = BAE.convertFromBase BAE.Base64
+
+  Right bytes <- liftA convert $ BS.readFile "ssk"
+  let ssk = SharedSecretKey bytes
+
+  Right pub  <- liftA convert $ BS.readFile "bob_public"
+  Right priv <- liftA convert $ BS.readFile "bob_private"
+
+  let keys = extract pub priv
+  case keys of
+    CryptoFailed err ->
+      undefined
+
+    CryptoPassed (priv', pub') ->
+      return (ssk, DHKeyPair priv' pub')

LICENSE

@@ -0,0 +1,13 @@
+Copyright 2017 Adjoint Inc
+
+Licensed under the Apache License, Version 2.0 (the "License");
+you may not use this file except in compliance with the License.
+You may obtain a copy of the License at
+
+    http://www.apache.org/licenses/LICENSE-2.0
+
+Unless required by applicable law or agreed to in writing, software
+distributed under the License is distributed on an "AS IS" BASIS,
+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+See the License for the specific language governing permissions and
+limitations under the License.

README.md

@@ -0,0 +1,73 @@
+Double Ratchet Algorithm
+========================
+
+An implementation of Open Whisper System's Double Ratchet Algorithm in Haskell.
+
+The Double Ratchet algorithm is used by two parties to exchange encrypted
+messages based on a shared secret key. Typically the parties will use some key
+agreement protocol (such as X3DH) to agree on the shared secret key.  Following
+this, the parties will use the Double Ratchet to send and receive encrypted
+messages.
+
+The parties derive new keys for every Double Ratchet message so that earlier
+keys cannot be calculated from later ones. The parties also send Diffie-Hellman
+public values attached to their messages. The results of Diffie-Hellman
+calculations are mixed into the derived keys so that later keys cannot be
+calculated from earlier ones. These properties gives some protection to earlier
+or later encrypted messages in case of a compromise of a party's keys.
+
+Usage
+-----
+
+The example will use the pre-shared keys `bob_private` and `bob_public` and `ssk`.
+
+To compile the example:
+
+```bash
+> stack ghc Example.hs --package ratchet 
+> ./Example server
+> ./Example client
+```
+
+To load in GHCi:
+
+```bash
+> stack ghci --package network
+> :load Example.hs
+```
+
+Protocol
+--------
+
+After an initial key exchange it manages the ongoing renewal and maintenance of
+short-lived session keys. It combines a cryptographic ratchet based on the
+Diffie–Hellman key exchange (DH) and a ratchet based on a key derivation
+function (KDF) like e.g. a hash function and is therefore called a double
+ratchet.
+
+* [The Double Ratchet Algorithm](https://whispersystems.org/docs/specifications/doubleratchet/)
+
+Signal Protocol protocol combines the Double Ratchet Algorithm, prekeys, and a
+triple Diffie–Hellman (3-DH) handshake, and uses Curve25519, AES-256 and
+HMAC-SHA256 as primitives.
+
+* [Extended Triple Diffie-Hellman](https://whispersystems.org/docs/specifications/x3dh/)
+
+License
+-------
+
+```
+Copyright 2017 Adjoint Inc
+
+Licensed under the Apache License, Version 2.0 (the "License");
+you may not use this file except in compliance with the License.
+You may obtain a copy of the License at
+
+    http://www.apache.org/licenses/LICENSE-2.0
+
+Unless required by applicable law or agreed to in writing, software
+distributed under the License is distributed on an "AS IS" BASIS,
+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+See the License for the specific language governing permissions and
+limitations under the License.
+```

Setup.hs

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

bob_private

@@ -0,0 +1 @@
+oGUnGXXfxtL/rhnm35wipxnscw6sXJGRv+ro/1c941Q=

bob_public

@@ -0,0 +1 @@
+uXKpMtSLxC073z3OwKue+riryfTPX1Z1SmybLTn6fHg=

circle.yml

@@ -0,0 +1,17 @@
+dependencies:
+  cache_directories:
+    - "~/.stack"
+    - "/home/ubuntu/ratchet/.stack-work"
+  pre:
+    - wget https://github.com/commercialhaskell/stack/releases/download/v1.4.0/stack-1.4.0-linux-x86_64.tar.gz -O /tmp/stack.tar.gz
+    - tar -zxvf /tmp/stack.tar.gz -C /tmp
+    - sudo mv /tmp/stack-**/stack /usr/bin/stack
+    - sudo apt-get update -q
+
+  override:
+    - stack setup --resolver lts-8.5 --no-docker
+    - stack build --fast --no-docker
+
+test:
+  override:
+    - stack test --no-docker