rfc 0.0.0.11 → 0.0.0.12
raw patch · 4 files changed
+235/−8 lines, 4 filesdep +attoparsecdep +servant-client
Dependencies added: attoparsec, servant-client
Files
- rfc.cabal +6/−5
- src/RFC/API.hs +29/−0
- src/RFC/Client/Coinhive.hs +164/−0
- src/RFC/JSON.hs +36/−3
rfc.cabal view
@@ -1,5 +1,5 @@ name: rfc-version: 0.0.0.11+version: 0.0.0.12 synopsis: Robert Fischer's Common library description: An enhanced Prelude and various utilities for Aeson, Servant, PSQL, and Redis that Robert Fischer uses. homepage: https://github.com/RobertFischer/rfc#README.md@@ -31,9 +31,6 @@ ghc-options: -Wall -fno-warn-orphans -fno-warn-name-shadowing if flag(Development) ghc-options: -Werror- else- if flag(Browser)- ghc-options: -dedupe build-depends: base >= 4.7 && < 5 , servant , classy-prelude@@ -59,6 +56,7 @@ , text if flag(Browser) build-depends: aeson+ , attoparsec if !flag(Browser) build-depends: servant-server , wai@@ -76,12 +74,14 @@ , swagger2 , binary , markdown+ , servant-client exposed-modules: RFC.Prelude , RFC.String , RFC.Concurrent , RFC.Throttle , RFC.JSON+ , RFC.API , RFC.HTTP.Types , RFC.Data.LatLng , RFC.Data.IdAnd@@ -99,8 +99,9 @@ , RFC.HTTP.Client , RFC.Servant , RFC.Servant.ApiDoc+ , RFC.Client.Coinhive if flag(Browser)- cpp-options: -DCLIENT -DGHCJS_BROWSER+ cpp-options: -DCLIENT -DGHCJS_BROWSER -DBROWSER source-repository head
+ src/RFC/API.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}++module RFC.API+ ( module RFC.API+ ) where++import RFC.Prelude ()++import Servant.API++-- |JSON DELETE+type JDelete a = Delete '[JSON] a++-- |JSON GET+type JGet a = Get '[JSON] a++-- |JSON PATCH+type JPatch a = Get '[JSON] a++-- |JSON POST+type JPost a = Post '[JSON] a++-- |JSON PUT+type JPut a = Post '[JSON] a++-- |JSON Request Body ('ReqBody')+type JReqBody a = ReqBody '[JSON] a
+ src/RFC/Client/Coinhive.hs view
@@ -0,0 +1,164 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-}++-- |Client to access API of Coinhive: https://coinhive.com/documentation/http-api+module RFC.Client.Coinhive+ ( module RFC.Client.Coinhive+ ) where++import RFC.Prelude++import Data.Aeson.Types as JSON+import RFC.API+import RFC.JSON+import Servant++#ifndef GHCJS_BROWSER+import Servant.Client+#endif++newtype SecretKey = SecretKey String deriving (FromJSON,ToJSON)+newtype TokenId = TokenId String deriving (FromJSON,ToJSON)++data TokenVerification = TokenVerification+ { tvSuccess :: Bool+ , tvHashes :: Integer+ , tvCreated :: Integer+ , tvError :: Maybe String+ }+$(deriveJSON jsonOptions ''TokenVerification)++data TokenVerifyRequest = TokenVerifyRequest+ { tvrSecret :: SecretKey+ , tvrToken :: TokenId+ , tvrHashes :: Integer+ }+$(deriveJSON jsonOptions ''TokenVerifyRequest)++data UserCurrentBalance = UserCurrentBalance+ { ucbSuccess :: Bool+ , ucbName :: String+ , ucbTotal :: Integer+ , ucbWithdrawn :: Integer+ , ucbBalance :: Integer+ , ucbError :: Maybe String+ }+$(deriveJSON jsonOptions ''UserCurrentBalance)++data UserWithdrawRequest = UserWithdrawRequest+ { uwrSecret :: SecretKey+ , uwrName :: String+ , uwrAmount :: Integer+ }+$(deriveJSON jsonOptions ''UserWithdrawRequest)++data UserWithdrawl = UserWithdrawl+ { uwSuccess :: Bool+ , uwName :: String+ , uwAmount :: Integer+ , uwError :: Maybe String+ }+$(deriveJSON jsonOptions ''UserWithdrawl)++data UserOrdering =+ TotalUserOrdering+ | BalanceUserOrdering+ | WithdrawnUserOrdering++instance FromJSON UserOrdering where+ parseJSON = withText "UserOrdering" $ \v ->+ case cs $ toLower v of+ "total" -> return TotalUserOrdering+ "balance" -> return BalanceUserOrdering+ "withdrawn" -> return WithdrawnUserOrdering+ _ -> typeMismatch "UserOrdering" (JSON.String v)++instance ToJSON UserOrdering where+ toJSON TotalUserOrdering = toJSON "total"+ toJSON BalanceUserOrdering = toJSON "balance"+ toJSON WithdrawnUserOrdering = toJSON "withdrawn"++-- |Represents a single user in a 'UserTopReport' or 'UserListReport'+data ReportUser = ReportUser+ { ruName :: String+ , ruTotal :: Integer+ , ruWithdrawn :: Integer+ , ruBalance :: Integer+ }+$(deriveJSON jsonOptions ''ReportUser)++-- |Report of top users by 'UserOrdering'.+data UserTopReport = UserTopReport+ { utrSuccess :: Bool+ , utrUsers :: [ReportUser]+ , utrError :: Maybe String+ }+$(deriveJSON jsonOptions ''UserTopReport)++data UserListReport = UserListReport+ { ulrSuccess :: Bool+ , ulrUsers :: [ReportUser]+ , ulrNextPage :: Maybe String+ , ulrError :: Maybe String+ }+$(deriveJSON jsonOptions ''UserListReport)++data UserResetRequest = UserResetRequest+ { urreqSecret :: SecretKey+ , urreqName :: String+ }+$(deriveJSON jsonOptions ''UserResetRequest)++data UserResetResult = UserResetResult+ { urrSuccess :: Bool+ , urrError :: Maybe String+ }+$(deriveJSON jsonOptions ''UserResetResult)+++api :: Proxy API+api = Proxy++-- |The unification of the various endpoints.+type API =+ TokenVerify+ :<|> UserBalance+ :<|> UserWithdraw+ :<|> UserTop+ :<|> UserList+ :<|> UserReset++type TokenVerify =+ "token" :> "verify" :> JReqBody TokenVerifyRequest :> JPost TokenVerification++type UserBalance =+ "user" :> "balance" :> QueryParam "secret" SecretKey :> QueryParam "name" String :> JGet UserCurrentBalance++type UserWithdraw =+ "user" :> "withdraw" :> JReqBody UserWithdrawRequest :> JPost UserWithdrawl++type UserTop =+ "user" :> "top" :> QueryParam "secret" SecretKey :> QueryParam "count" Integer :> QueryParam "order" UserOrdering :> JGet UserTopReport++type UserList =+ "user" :> "list" :> QueryParam "secert" SecretKey :> QueryParam "count" Integer :> QueryParam "page" String :> JGet UserListReport++type UserReset =+ "user" :> "reset" :> JReqBody UserResetRequest :> JPost UserResetResult++#ifndef GHCJS_BROWSER++-- |The URL prefix used for Coinhive's API+baseUrl :: BaseUrl+baseUrl = BaseUrl+ { baseUrlScheme = Https+ , baseUrlHost = "api.coinhive.com"+ , baseUrlPort = 443+ , baseUrlPath = "/"+ }++#endif
src/RFC/JSON.hs view
@@ -21,12 +21,24 @@ ) where import ClassyPrelude-import Data.Aeson as JSON-import Data.Aeson.TH (deriveJSON)-import Data.Aeson.Types (Options (..), SumEncoding (..), Value (..))+import Data.Aeson as JSON+import Data.Aeson.Parser as JSONParser+import Data.Aeson.TH (deriveJSON)+import Data.Aeson.Types (Options (..), SumEncoding (..),+ Value (..)) import Data.Char import RFC.String+import Web.HttpApiData +-- How we go about executing the parser+#if MIN_VERSION_aeson(1,0,0)+import Data.Aeson.Text as JSON+import qualified Data.Aeson.Types as JSONTypes+#else+import Data.Attoparsec.ByteString as JSON+import Data.Either (either)+#endif+ jsonOptions :: Options jsonOptions = defaultOptions { sumEncoding = ObjectWithSingleField@@ -58,3 +70,24 @@ Left err -> throwM $ DecodeError (input, err) Right a -> return a +instance FromHttpApiData JSON.Value where+ parseUrlPiece text =+ case parsed of+ Nothing -> Left $ (cs "Could not parse JSON: ") ++ text+ (Just value) -> Right value+ where+ parser = JSONParser.value'+ parsed =+#if MIN_VERSION_aeson(1,0,0)+ JSONParser.decodeStrictWith parser JSONTypes.Success (cs text)+#else+ either (const Nothing) Just $ JSON.parseOnly parser (cs text)+#endif++instance ToHttpApiData JSON.Value where+ toUrlPiece =+#if MIN_VERSION_aeson(1,0,0)+ cs . JSON.encodeToLazyText+#else+ cs . JSON.encode+#endif