summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorwangbj <>2016-06-16 01:43:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2016-06-16 01:43:00 (GMT)
commitd2ea4df79b15bef2ceb43381f4ea169713d0a641 (patch)
tree0c3a055e82530073441f60aa5417d1e5feae6e5d
version 0.1.1.00.1.1.0
-rw-r--r--LICENSE30
-rw-r--r--Setup.hs2
-rw-r--r--aur-api.cabal38
-rw-r--r--src/Distribution/ArchLinux/AUR.hs20
-rw-r--r--src/Distribution/ArchLinux/AUR/RPC.hs65
-rw-r--r--src/Distribution/ArchLinux/AUR/Types.hs120
6 files changed, 275 insertions, 0 deletions
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..3a792ec
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Baojun Wang (c) 2016
+
+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 Author name here 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.
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/aur-api.cabal b/aur-api.cabal
new file mode 100644
index 0000000..21b6120
--- /dev/null
+++ b/aur-api.cabal
@@ -0,0 +1,38 @@
+name: aur-api
+version: 0.1.1.0
+synopsis: ArchLinux AUR json v5 API
+description: Implements ArchLinux AUR json v5 API defined at:
+ .
+ https://wiki.archlinux.org/index.php/AurJson
+ .
+homepage: https://github.com/wangbj/aur-api
+license: BSD3
+license-file: LICENSE
+author: Baojun Wang
+maintainer: wangbj@gmail.com
+copyright: 2016 Baojun Wang
+category: Web
+build-type: Simple
+bug-reports: https://github.com/wangbj/aur-api/issues
+-- extra-source-files:
+cabal-version: >=1.10
+
+library
+ hs-source-dirs: src
+ exposed-modules: Distribution.ArchLinux.AUR
+ , Distribution.ArchLinux.AUR.Types
+ , Distribution.ArchLinux.AUR.RPC
+ build-depends: base >= 4.7 && < 5
+ , aeson >= 0.9.0.0 && < 0.12.0.0
+ , text >= 1.1.0.0 && < 1.3.0.0
+ , bytestring >= 0.10.6.0
+ , mtl >= 2.2.1
+ , exceptions >= 0.8.2.1 && < 1.0.0.0
+ , http-client >= 0.4.0
+ , http-client-tls >= 0.2.0
+ , hspec >= 2.2.0
+ default-language: Haskell2010
+
+source-repository head
+ type: git
+ location: https://github.com/wangbj/aur-api
diff --git a/src/Distribution/ArchLinux/AUR.hs b/src/Distribution/ArchLinux/AUR.hs
new file mode 100644
index 0000000..7f523d8
--- /dev/null
+++ b/src/Distribution/ArchLinux/AUR.hs
@@ -0,0 +1,20 @@
+-- | Implements AUR json API (v5)
+--
+-- AUR json API spec can be found at https://wiki.archlinux.org/index.php/AurJson
+--
+-- * 'info': Query metadata for list of packages (match exact names)
+--
+-- * 'searchBy': Search a given pattern by either /name/, /desc/, or /name-desc/
+--
+-- * 'search': Synonym of /searchBy ByNameDesc/.
+--
+module Distribution.ArchLinux.AUR
+ ( SearchBy (..)
+ , AURInfo (..)
+ , info
+ , searchBy
+ , search
+ ) where
+
+import Distribution.ArchLinux.AUR.Types
+import Distribution.ArchLinux.AUR.RPC
diff --git a/src/Distribution/ArchLinux/AUR/RPC.hs b/src/Distribution/ArchLinux/AUR/RPC.hs
new file mode 100644
index 0000000..23bb83c
--- /dev/null
+++ b/src/Distribution/ArchLinux/AUR/RPC.hs
@@ -0,0 +1,65 @@
+-- | AUR json API implementation (v5)
+--
+-- AUR json API spec can be found at https://wiki.archlinux.org/index.php/AurJson
+--
+{-# LANGUAGE OverloadedStrings #-}
+module Distribution.ArchLinux.AUR.RPC
+ ( info
+ , searchBy
+ , search
+ ) where
+
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Text as Text
+import Data.Text (Text)
+import Control.Monad.Except
+import Control.Monad.Catch
+import Network.HTTP.Client
+import Network.HTTP.Client.TLS
+import Data.Aeson
+import Distribution.ArchLinux.AUR.Types
+
+aurServer = "https://aur.archlinux.org/rpc/?v=" ++ show aurApi
+ where aurApi = 5
+
+genURL :: AURQuery -> String
+genURL (QSearch field txt) = aurServer ++ "&type=search&by=" ++ show field ++ "&arg=" ++ txt
+genURL (QInfo q) = aurServer ++ "&type=info" ++ concatMap (\x -> "&arg%5b%5d="++x) q
+
+get s = join $ liftM2 httpLbs (parseUrl (genURL s)) (newManager tlsManagerSettings)
+
+getM :: (MonadIO m) => AURQuery -> ExceptT String m (Response LBS.ByteString)
+getM s = ExceptT . liftIO $ fmap Right (get s) `catch` (\(SomeException e) -> return (Left (show e)))
+
+queryAUR :: (MonadIO m) => AURQuery -> ExceptT String m [AURInfo]
+queryAUR s = getM s >>= \r -> ExceptT . return $ (eitherDecode >=> getAURInfo) (responseBody r)
+
+concatMapM :: (Monad m, Foldable t) => (a -> m [b]) -> t a -> m [b]
+concatMapM op = foldr f (return [])
+ where
+ f x xs = do x <- op x
+ if null x then xs else fmap (x ++) xs
+
+-- |Query info of given list of packages, match exact names
+-- possible return types are /multiinfo/ and /error/.
+-- /error/ type is captured by ExceptT (Left).
+-- However, query may return empty list which isn't considered as an error.
+info :: (MonadIO m) => [String] -> ExceptT String m [AURInfo]
+info = concatMapM (queryAUR . QInfo) . chunks
+
+-- Avoid encode arbitrary long URL when ``info`` package list is too long.
+chunks :: [String] -> [[String]]
+chunks s = if null s then [] else s1 : chunks s'
+ where (s1, s') = splitAt 1024 s
+
+-- |searchBy field 'SearchBy' given string on AUR server
+-- possible return types are /search/ and /error/.
+-- Like 'info', /error/ is captured by a Left.
+searchBy :: (MonadIO m) => SearchBy -> String -> ExceptT String m [AURInfo]
+searchBy f = queryAUR . QSearch f
+
+-- |synonym of 'searchBy' /ByNameDesc/
+search :: (MonadIO m) => String -> ExceptT String m [AURInfo]
+search = searchBy ByNameDesc
+
+url1 = "https://aur.archlinux.org/rpc/?v=5&type=info&arg%5b%5d=icaclient"
diff --git a/src/Distribution/ArchLinux/AUR/Types.hs b/src/Distribution/ArchLinux/AUR/Types.hs
new file mode 100644
index 0000000..d7bcf83
--- /dev/null
+++ b/src/Distribution/ArchLinux/AUR/Types.hs
@@ -0,0 +1,120 @@
+-- |Primitive types used for AUR RPC (json) API.
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
+module Distribution.ArchLinux.AUR.Types
+ ( SearchBy (..)
+ , ReplyType (..)
+ , AURQuery (..)
+ , AURReply (..)
+ , AURInfo (..)
+ , getAURInfo
+ ) where
+
+import qualified Data.Text as Text
+import Data.Text (Text)
+import Data.Aeson.Types (Parser)
+import Data.Aeson
+
+data SearchBy = ByName | ByNameDesc | ByMaintainer
+
+instance Show SearchBy where
+ show ByName = "name"
+ show ByNameDesc = "name-desc"
+ show ByMaintainer = "maintainer"
+
+data AURQuery = QSearch SearchBy String
+ | QInfo [String]
+
+data ReplyType = ReplySearch | ReplyMultiInfo | ReplyError
+instance Show ReplyType where
+ show ReplySearch = "search"
+ show ReplyMultiInfo = "multiinfo"
+ show ReplyError = "error"
+
+getReplyType :: String -> Parser ReplyType
+getReplyType s
+ | s == "search" = return ReplySearch
+ | s == "multiinfo" = return ReplyMultiInfo
+ | s == "error" = return ReplyError
+ | otherwise = fail $ "cannot parse aur return type, " ++ s ++
+ " is not one of [search, multiinfo, error] "
+
+data AURReply f a = AURReply {
+ retVersion :: Int
+ , retType :: ReplyType
+ , retResultCount :: Int
+ , retResults :: f a
+ , retError :: Maybe String
+ } deriving (Show, Functor)
+
+getAURInfo :: (Functor f,
+ Applicative f,
+ Foldable f,
+ Traversable f) =>
+ AURReply f a ->
+ Either String (f a)
+getAURInfo (AURReply _ t n r e) = case t of
+ ReplySearch -> return r
+ ReplyMultiInfo -> return r
+ ReplyError -> maybe (Left "") Left e
+
+instance
+ (Functor f,
+ Applicative f,
+ Foldable f,
+ Traversable f,
+ FromJSON a,
+ FromJSON (f a)) => FromJSON (AURReply f a) where
+ parseJSON (Object v) = AURReply
+ <$> v .: "version"
+ <*> (v .: "type" >>= getReplyType)
+ <*> v .: "resultcount"
+ <*> v .: "results"
+ <*> v .:? "error"
+
+data AURInfo = AURInfo {
+ packageID :: Int
+ , packageName :: Text
+ , packagePackageBaseID :: Int
+ , packagePackageBase :: Text
+ , packageVersion :: Text
+ , packageDescription :: Text
+ , packageURL :: Text
+ , packageNumVotes :: Int
+ , packagePopularity :: Double
+ , packageOutOfDate :: Maybe Int
+ , packageMaintainer :: Maybe Text
+ , packageFirstSubmitted :: Int
+ , packageLastModified :: Int
+ , packageURLPath :: Text
+ , packageDepends :: [Text]
+ , packageMakeDepends :: [Text]
+ , packageOptDepends :: [Text]
+ , packageConflicts :: [Text]
+ , packageLicense :: [Text]
+ , packageKeywords :: [Text]
+ } deriving (Show)
+
+instance FromJSON AURInfo where
+ parseJSON (Object v) = AURInfo
+ <$> v .: "ID"
+ <*> v .: "Name"
+ <*> v .: "PackageBaseID"
+ <*> v .: "PackageBase"
+ <*> v .: "Version"
+ <*> v .: "Description"
+ <*> v .: "URL"
+ <*> v .: "NumVotes"
+ <*> v .: "Popularity"
+ <*> v .: "OutOfDate"
+ <*> v .:? "Maintainer"
+ <*> v .: "FirstSubmitted"
+ <*> v .: "LastModified"
+ <*> v .: "URLPath"
+ <*> v .:! "Depends" .!= []
+ <*> v .:! "MakeDepends" .!= []
+ <*> v .:! "OptDepends" .!= []
+ <*> v .:! "Conflicts" .!= []
+ <*> v .:! "License" .!= []
+ <*> v .:! "Keywords" .!= []