bencoding-lens (empty) → 0.1.0.0

raw patch · 7 files changed

+386/−0 lines, 7 filesdep +basedep +bencodingdep +bencoding-lens

Dependencies added: base, bencoding, bencoding-lens, bytestring, cryptonite, hspec, http-conduit, lens

Files

.gitignore +28/−0
CHANGELOG.md +5/−0
LICENSE +27/−0
README.md +46/−0
bencoding-lens.cabal +58/−0
src/Data/BEncode/Lens.hs +191/−0
test/Torrent.hs +31/−0

+ .gitignore view

@@ -0,0 +1,28 @@+.DS_Store+.idea+*.log+tmp/++dist+dist-*+cabal-dev+*.o+*.hi+*.hie+*.chi+*.chs.h+*.dyn_o+*.dyn_hi+.hpc+.hsenv+.cabal-sandbox/+cabal.sandbox.config+*.prof+*.aux+*.hp+*.eventlog+.stack-work/+cabal.project.local+cabal.project.local~+.HTF/+.ghc.environment.*

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for bencoding-lens++## 0.1.0.0 -- 2022-02-22++* First version. Released on an unsuspecting world.

+ LICENSE view

@@ -0,0 +1,27 @@+Copyright (c) 2021-2022 Joseph Morag+All rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the copyright holder nor the names of its 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 HOLDER 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 view

@@ -0,0 +1,46 @@+# bencoding-lens++Law abiding lenses and traversals for+[bencoding](https://hackage.haskell.org/package/bencoding), ported from+[lens-aeson](https://hackage.haskell.org/package/lens-aeson-1.1.1). Works with+arbitrary bencoded data, although most examples in the wild are torrent files.+++``` haskell+{-# LANGUAGE OverloadedStrings #-}++import Control.Lens+import Data.BEncode+import Data.BEncode.Lens++import Network.HTTP.Simple -- from http-conduit+import Crypto.Hash -- from cryptonite++main = do+  -- Get the ubuntu 20.04 live server torrent file with http-conduit+  torrent <- getResponseBody <$> httpBS "https://releases.ubuntu.com/20.04/ubuntu-20.04.4-live-server-amd64.iso.torrent"+  -- Print some interesting bits of the torrent file++  -- Announce link+  print (torrent ^? key "announce") +  -- Just (BString "https://torrent.ubuntu.com/announce")++  -- Keys of the top level dict+  print (fmap fst (torrent ^@.. members))+  -- ["announce","announce-list","comment","created by","creation date","info"]++  -- Keys of the info dict+  print (fmap fst (torrent ^@.. key "info" . members))+  -- ["length","name","piece length","pieces"]++  -- Piece length+  print (torrent ^? key "info" . key "piece length" . _BInteger)+  -- Just 262144++  -- Compute the info hash (see definition below)+  print (torrent ^?! infoHash)+  -- b44a0e20fa5b7cecb77156333b4268dfd7c30afb+  +infoHash :: (AsBValue t) => Fold t (Digest SHA1)+infoHash = key "info" . to (hashlazy . encode)+```

+ bencoding-lens.cabal view

@@ -0,0 +1,58 @@+cabal-version:      >=1.10+name:               bencoding-lens+version:            0.1.0.0+synopsis:           Lenses for bencoded data.+description:        A port of lens-aeson for bencoding.+homepage:           https://github.com/jmorag/bencoding-lens+bug-reports:        https://github.com/jmorag/bencoding-lens/issues+license:            BSD3+license-file:       LICENSE+author:             Joseph Morag+maintainer:         Joseph Morag <jm@josephmorag.com>+copyright:          (c) 2021-2022, Joseph Morag+category:           Data+extra-source-files:+  .gitignore+  CHANGELOG.md+  README.md++build-type:         Simple+tested-with:+  GHC ==7.10.3+   || ==8.0.2+   || ==8.2.2+   || ==8.4.4+   || ==8.6.5+   || ==8.8.4+   || ==8.10.7+   || ==9.0.2+   || ==9.2.2++source-repository head+  type:     git+  location: https://github.com/jmorag/bencoding-lens++library+  default-language: Haskell2010+  hs-source-dirs:   src+  exposed-modules:  Data.BEncode.Lens+  ghc-options:      -Wall+  build-depends:+      base        >=4.4      && <4.18+    , bencoding   >=0.4.5.4  && <0.5+    , bytestring  >=0.10.4.1 && <0.12+    , lens        >=4        && <5.2++test-suite bencoding-lens-torrent-test+  default-language: Haskell2010+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Torrent.hs+  build-depends:+      base        >=4.4      && <4.18+    , lens        >=4        && <5.2+    , bencoding+    , bencoding-lens+    , http-conduit+    , cryptonite+    , hspec

+ src/Data/BEncode/Lens.hs view

@@ -0,0 +1,191 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Copyright :  (c) Joseph Morag 2021-2022+-- License   :  BSD3+-- Maintainer:  Joseph Morag <jm@josephmorag.com>+-- Stability :  experimental+-- Portability: non-portable+--+-- This module exports orphan instances for @'Ixed' 'BValue'@, @'Plated'+-- 'BValue'@, @'Ixed' 'BDictMap'@, @'Plated' 'BDictMap'@, @'Traversable'+-- 'BDictMap'@, @'FunctorWithIndex' 'BDictMap'@, @'FoldableWithIndex'+-- 'BDictMap'@, and @'TraversbaleWithIndex' 'BDictMap'@.+module Data.BEncode.Lens+  ( -- * Prisms+    AsBValue (..),++    -- * BDicts and BLists+    members,+    key,+    nth,+    values,+  )+where++import Control.Lens+import Data.BEncode+import Data.BEncode.BDict as BE+import Data.BEncode.Types+import qualified Data.ByteString as Strict+import qualified Data.ByteString.Lazy as Lazy++-- $setup+-- >>> import Control.Lens+-- >>> import Data.ByteString+-- >>> import Data.BEncode.BDict+-- >>> import Data.BEncode.Types+-- >>> :set -XOverloadedStrings++-- | Things that can be treated as a 'BValue'. Instances are provided for strict+-- and lazy 'ByteString' as well as 'BValue's themselves.+class AsBValue t where+  _BValue :: Prism' t BValue++  -- |+  -- >>> ("i3e" :: ByteString) ^? _BInteger+  -- Just 3+  _BInteger :: Prism' t BInteger+  _BInteger = _BValue . prism' BInteger (\case BInteger x -> Just x; _ -> Nothing)+  {-# INLINE _BInteger #-}++  -- |+  -- >>> ("0:" :: ByteString) ^? _BString+  -- Just ""+  --+  -- >>> ("4:spam" :: ByteString) ^? _BString+  -- Just "spam"+  _BString :: Prism' t BString+  _BString = _BValue . prism' BString (\case BString x -> Just x; _ -> Nothing)+  {-# INLINE _BString #-}++  -- |+  -- >>> ("le" :: ByteString) ^? _BList+  -- Just []+  --+  -- >>> ("l4:spam4:eggse" :: ByteString) ^? _BList == Just [BString "spam", BString "eggs"]+  -- True+  _BList :: Prism' t BList+  _BList = _BValue . prism' BList (\case BList x -> Just x; _ -> Nothing)+  {-# INLINE _BList #-}++  -- |+  -- >>> ("de" :: ByteString) ^? _BDict+  -- Just Nil+  --+  -- >>> ("d3:cow3:moo4:spam4:eggse" :: ByteString) ^? _BDict == Just (Cons "cow" (BString "moo") (Cons "spam" (BString "eggs") Nil))+  -- True+  _BDict :: Prism' t BDict+  _BDict = _BValue . prism' BDict (\case BDict x -> Just x; _ -> Nothing)+  {-# INLINE _BDict #-}++instance AsBValue BValue where+  _BValue = id+  {-# INLINE _BValue #-}++instance AsBValue Strict.ByteString where+  _BValue = prism' (view strict . encode) $ either (const Nothing) Just . decode+  {-# INLINE _BValue #-}++instance AsBValue Lazy.ByteString where+  _BValue = prism' encode $ either (const Nothing) Just . decode . view strict+  {-# INLINE _BValue #-}++-- |+-- >>> ("d3:cow3:moo4:spam4:eggse" :: ByteString) ^@.. members+-- [("cow",BString "moo"),("spam",BString "eggs")]+members :: AsBValue t => IndexedTraversal' BKey t BValue+members = _BDict . itraversed+{-# INLINE members #-}++-- |+-- >>> ("d3:cow3:moo4:spam4:eggse" :: ByteString) ^? key "cow"+-- Just (BString "moo")+key :: AsBValue t => BKey -> Traversal' t BValue+key k = _BDict . ix k+{-# INLINE key #-}++-- |+-- >>> ("li0ei1ee" :: ByteString) ^? nth 0+-- Just (BInteger 0)+nth :: AsBValue t => Int -> Traversal' t BValue+nth i = _BList . ix i+{-# INLINE nth #-}++-- |+-- >>> ("ll1:ae3:cow3:moo4:spam4:eggse" :: ByteString) ^.. values+-- [BList [BString "a"],BString "cow",BString "moo",BString "spam",BString "eggs"]+values :: AsBValue t => IndexedTraversal' Int t BValue+values = _BList . traversed+{-# INLINE values #-}++------------------------------------------------------------------------------+-- Orphan instances for lens library interop+------------------------------------------------------------------------------+instance Traversable BDictMap where+  traverse _ Nil = pure Nil+  traverse f (Cons k x xs) = Cons k <$> f x <*> traverse f xs++instance FoldableWithIndex BKey BDictMap++instance FunctorWithIndex BKey BDictMap++instance TraversableWithIndex BKey BDictMap where+  itraverse _ Nil = pure Nil+  itraverse f (Cons k x xs) = Cons k <$> f k x <*> itraverse f xs++type instance Index (BDictMap a) = BKey++type instance IxValue (BDictMap a) = a++type instance Index BValue = BKey++type instance IxValue BValue = BValue++instance At (BDictMap a) where+  at :: BKey -> Lens' (BDictMap a) (Maybe a)+  at k f m =+    f mv <&> \case+      Nothing -> maybe m (const (delete k m)) mv+      Just v' -> insert k v' m+    where+      mv = BE.lookup k m+  {-# INLINE at #-}++-- | Insert a key value pair into a BDictMap. Overwrites the value for an+-- existing key+insert :: BKey -> a -> BDictMap a -> BDictMap a+insert k v Nil = BE.singleton k v+insert k v bd@(Cons k' x xs)+  | k == k' = Cons k v xs+  | k < k' = Cons k v bd+  | otherwise = Cons k' x (insert k v xs)++-- | Delete a key from a BDictMap. Returns the BDictMap unchanged if the key is+-- not present.+delete :: BKey -> BDictMap a -> BDictMap a+delete _ Nil = Nil+delete k bd@(Cons k' x xs)+  | k == k' = xs+  | k > k' = bd+  | otherwise = Cons k' x (delete k xs)++instance Ixed (BDictMap a)++instance Ixed BValue where+  ix i f (BDict o) = BDict <$> ix i f o+  ix _ _ v = pure v+  {-# INLINE ix #-}++instance Plated BValue where+  plate f (BDict o) = BDict <$> traverse f o+  plate f (BList l) = BList <$> traverse f l+  plate _ xs = pure xs+  {-# INLINE plate #-}

+ test/Torrent.hs view

@@ -0,0 +1,31 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE OverloadedStrings #-}++import Control.Lens+import Crypto.Hash+import Data.BEncode+import Data.BEncode.Lens+import Network.HTTP.Simple+import Test.Hspec++main = do+  -- Get the ubuntu 20.04 live server torrent file with http-conduit+  resp <- httpBS "https://releases.ubuntu.com/20.04/ubuntu-20.04.4-live-server-amd64.iso.torrent"+  let torrent = getResponseBody resp+  hspec do+    it "should get the corrent ubuntu announce string" do+      (torrent ^?! key "announce" . _BString) `shouldBe` "https://torrent.ubuntu.com/announce"+    it "should get the keys of the top level dict" do+      fmap fst (torrent ^@.. members) `shouldBe` ["announce", "announce-list", "comment", "created by", "creation date", "info"]++    it "should get the keys of the info dict" do+      fmap fst (torrent ^@.. key "info" . members) `shouldBe` ["length", "name", "piece length", "pieces"]++    it "should find the piece length" do+      (torrent ^?! key "info" . key "piece length" . _BInteger) `shouldBe` 262144++    it "should compute the info hash (see definition below)" do+      show (torrent ^?! infoHash) `shouldBe` "b44a0e20fa5b7cecb77156333b4268dfd7c30afb"++infoHash :: (AsBValue t) => Fold t (Digest SHA1)+infoHash = key "info" . to (hashlazy . encode)