metro-transport-xor (empty) → 0.1.0.0

raw patch · 6 files changed

+131/−0 lines, 6 filesdep +basedep +bytestringdep +metrosetup-changed

Dependencies added: base, bytestring, metro, unliftio

Files

• ChangeLog.md +3/−0
• LICENSE +30/−0
• README.md +3/−0
• Setup.hs +2/−0
• metro-transport-xor.cabal +42/−0
• src/Metro/TP/XOR.hs +51/−0

@@ -0,0 +1,3 @@+# Changelog for metro-transport-xor++## Unreleased changes

@@ -0,0 +1,30 @@+Copyright Lupino (c) 2020++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 Lupino 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.

@@ -0,0 +1,3 @@+# metro-transport-xor++XOR transport for metro

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

@@ -0,0 +1,42 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 26cdb0c1ac2f5da948e47a5131ca3f08fb15757b56bac7f6d805154e32d656ad++name:           metro-transport-xor+version:        0.1.0.0+synopsis:       XOR transport for metro+description:    Please see the README on GitHub at <https://github.com/Lupino/metro/tree/master/metro-transport-xor#readme>+category:       Web+homepage:       https://github.com/Lupino/metro#readme+bug-reports:    https://github.com/Lupino/metro/issues+author:         Lupino+maintainer:     lmjubuntu@gmail.com+copyright:      MIT+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/Lupino/metro++library+  exposed-modules:+      Metro.TP.XOR+  other-modules:+      Paths_metro_transport_xor+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , bytestring+    , metro+    , unliftio+  default-language: Haskell2010

@@ -0,0 +1,51 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies    #-}++module Metro.TP.XOR+  ( xorBS+  , XOR+  , xorConfig+  ) where++import           Data.Bits            (xor)+import qualified Data.ByteString      as B+import qualified Data.ByteString.Lazy as LB+import           Metro.Class          (Transport (..))+import qualified Metro.Lock           as L+import           UnliftIO++data XOR tp = XOR+    { transport :: tp+    , sn        :: TVar LB.ByteString+    , rn        :: TVar LB.ByteString+    , sl        :: L.Lock+    , rl        :: L.Lock+    }++instance Transport tp => Transport (XOR tp) where+  data TransportConfig (XOR tp) = XORConfig FilePath (TransportConfig tp)+  newTransport (XORConfig fn config) = do+    transport <- newTransport config+    key <- LB.readFile fn+    sn <- newTVarIO $ LB.cycle key+    rn <- newTVarIO $ LB.cycle key+    sl <- L.new+    rl <- L.new+    return XOR {..}++  recvData XOR {..} nbytes = L.with rl $ xorBS rn =<< recvData transport nbytes+  sendData XOR {..} bs = L.with sl $ xorBS sn bs >>= sendData transport+  closeTransport XOR {..} = closeTransport transport++xorBS :: TVar LB.ByteString -> B.ByteString -> IO B.ByteString+xorBS ref bs = atomically $ do+  buf <- readTVar ref+  writeTVar ref $! LB.drop len buf+  return . xor' $! LB.take len buf++ where  bs' = LB.fromStrict bs+        len = LB.length bs'+        xor' = B.pack . LB.zipWith xor bs'++xorConfig :: FilePath -> TransportConfig tp -> TransportConfig (XOR tp)+xorConfig = XORConfig