dropbox (empty) → 0.0.0

raw patch · 9 files changed

+451/−0 lines, 9 filesdep +aesondep +aeson-qqdep +base

Dependencies added: aeson, aeson-qq, base, dropbox, hspec, hspec-core, http-api-data, http-client-tls, servant, servant-auth, servant-auth-client, servant-client, servant-client-core, text

Files

• Changelog.md +11/−0
• LICENSE +21/−0
• Readme.md +36/−0
• app/exe.hs +15/−0
• dropbox.cabal +96/−0
• src/Dropbox.hs +164/−0
• test/DropboxSpec.hs +91/−0
• test/Spec.hs +1/−0
• test/Test/TestSpec.hs +16/−0

@@ -0,0 +1,11 @@+# Change log for dropbox ++## Version 0.0.0 +++ Add suppport for+  + list folder (see what is in a users folder)+  + get temporary link (download file support)+  + dropbox token (allow us to get access to a users dropbox)++ Add basic encoding/decoding tests for datatypes from dropbox api docs++ import [template](https://github.com/jappeace/haskell-template-project).+

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2019 Jappie Klooster++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,36 @@+[![Githbu actions build status](https://img.shields.io/github/workflow/status/jappeace/haskell-template-project/Test)](https://github.com/riskbook/dropbox-client/actions)++> It doesn't actually replace a USB drive.+>+> \- BrandomM on hacker news, commenting on the dropbox idea, 2007++This is an incomplete dropbox API client derived from a servant+generic type definition.+Additional endpoints are welcome, feel free to make a PR!++## History+This is the result from the great riskbook hackathon+of oktober 2020+(also known as festoberhack).++## Usage++### Tools+Enter the nix shell.+```+nix-shell+```+You can checkout the makefile to see what's available:+```+cat makefile+```++### Running+```+make run+```++### Fast filewatch which runs tests+```+make ghcid+```

@@ -0,0 +1,15 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Prelude (IO, print, (=<<))+import Dropbox+import Servant.Auth.Client++token :: Token+token = Token "sl.AkC0dOjbLWtkw7ikA6RePKDX-2Y-7IELqRX0043qMoX1ubN-q3DJ2BxUFR_JFhJKA56dEeKzenxJtFEunQ_Y3gmzsWOir8DBdRxJa1sIIwNLseJIaJ-xKIWH4HBuSLB3RImwlqY"++main :: IO ()+main = do+  client <- createClient+  print =<< _dropbox_list_folder client token defListFolderRequest

@@ -0,0 +1,96 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.2.+--+-- see: https://github.com/sol/hpack++name:           dropbox+version:        0.0.0+synopsis:       Dropbox API client+description:    A dropbox API client generated through servant generic.+category:       API+homepage:       https://github.com/riskbook/dropbox#readme+bug-reports:    https://github.com/riskbook/dropbox/issues+author:         Riskbook+maintainer:     support@riskbook.com+copyright:      2020 Riskbook+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    Readme.md+    LICENSE+    Changelog.md++source-repository head+  type: git+  location: https://github.com/riskbook/dropbox++library+  exposed-modules:+      Dropbox+  other-modules:+      Paths_dropbox+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Wincomplete-uni-patterns -Wredundant-constraints -Wincomplete-record-updates -Widentities+  build-depends:+      aeson+    , base >=4.7 && <5+    , http-api-data+    , http-client-tls+    , servant+    , servant-auth+    , servant-auth-client+    , servant-client+    , servant-client-core+    , text+  default-language: Haskell2010++executable exe+  main-is: exe.hs+  other-modules:+      Paths_dropbox+  hs-source-dirs:+      app+  ghc-options: -Wall -Wcompat -Wincomplete-uni-patterns -Wredundant-constraints -Wincomplete-record-updates -Widentities -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      aeson+    , base >=4.7 && <5+    , dropbox+    , http-api-data+    , http-client-tls+    , servant+    , servant-auth+    , servant-auth-client+    , servant-client+    , servant-client-core+    , text+  default-language: Haskell2010++test-suite unit+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      DropboxSpec+      Test.TestSpec+      Paths_dropbox+  hs-source-dirs:+      test+  ghc-options: -Wall -Wcompat -Wincomplete-uni-patterns -Wredundant-constraints -Wincomplete-record-updates -Widentities+  build-depends:+      aeson+    , aeson-qq+    , base >=4.7 && <5+    , dropbox+    , hspec+    , hspec-core+    , http-api-data+    , http-client-tls+    , servant+    , servant-auth+    , servant-auth-client+    , servant-client+    , servant-client-core+    , text+  default-language: Haskell2010

@@ -0,0 +1,164 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}++-- | A dropbox client+--+module Dropbox+  ( createClient+  , dropboxProxy+  , Dropbox(..)+  , defListFolderRequest+  , FileTag(..)+  , Entry(..)+  , ListFolderResponse(..)+  , ListFolderRequest+  , path+  , LinkResponse(..)+  , LinkRequest(..)+  ) where++import Control.Exception(throwIO)+import Data.Proxy+import Data.Text(Text)+import Network.HTTP.Client.TLS+import Servant.API+import Servant.Client.Generic+import Servant.API.Generic+import Data.Aeson+import Servant.Auth+import Servant.Auth.Client+import Servant.Client+import Web.FormUrlEncoded hiding (fieldLabelModifier)+import Data.Char (isLower)++toSnake :: String -> String+toSnake = camelTo2 '_' . dropWhile isLower++data ListFolderRequest = ListFolderRequest+  { path :: String+  , recursive :: Bool+  , include_media_info :: Bool+  , include_deleted :: Bool+  , include_has_explicit_shared_members :: Bool+  , include_mounted_folders :: Bool+  , include_non_downloadable_files :: Bool+} deriving (Generic, ToJSON)++newtype LinkRequest = LinkRequest+  { linkPath :: String+  } deriving (Generic)++instance ToJSON LinkRequest where+    -- this generates a Value+    toJSON (LinkRequest lpath) =+        object ["path" .= lpath]++defListFolderRequest :: ListFolderRequest+defListFolderRequest = ListFolderRequest+  { path = "" -- root is empty string in dropbox api+  , recursive = False+  , include_media_info = False+  , include_deleted = False+  , include_has_explicit_shared_members = False+  , include_mounted_folders = True+  , include_non_downloadable_files = False+  }++data FileTag = File | Folder+  deriving (Generic, FromJSON, Show, Eq)++data Entry = Entry+  { eTag :: FileTag+  , eName :: Text+  , ePathDisplay :: Text+  , eId :: Text+  } deriving (Generic, Show, Eq)++instance FromJSON Entry where+  parseJSON = withObject "Entry" $ \v -> do+    tag' :: Text <- v .: ".tag"+    let eTag = if tag' == "file" then File else Folder+    eName <- v .: "name"+    ePathDisplay <- v .: "path_display"+    eId <- v .: "id"+    pure $ Entry {..}++newtype ListFolderResponse = ListFolderResponse+  { entries :: [Entry]+  } deriving (Generic, FromJSON, Show, Eq)++-- https://www.dropbox.com/developers/documentation/http/documentation#oauth2-token+data TokenRequest = TokenRequest+  { trAccessToken :: Text+  , trExpiresIn :: Maybe Int -- seconds+  , trTokenType :: Text+  , trRefreshToken :: Maybe Text+  , trScope :: Text+  , trAccountId :: Text+  , trUid :: Text+  } deriving Generic++snakeConstructor :: Options+snakeConstructor = defaultOptions { constructorTagModifier = camelTo2 '_' }++snakeLabel :: Options+snakeLabel = snakeConstructor { fieldLabelModifier = toSnake }++instance FromJSON TokenRequest where+  parseJSON = genericParseJSON snakeLabel++data TokenBody = TokenBody+  { code         :: Maybe Text+  , refresh_token :: Maybe Text+  , grant_type    :: Text+  , redirect_uri  :: Text+  , client_id     :: Text+  , client_secret :: Text+  } deriving (Generic, Show, ToForm)++newtype LinkResponse = LinkResponse {+  link :: Text+  } deriving (Generic, Show, FromJSON)++-- | To use the various endpoints make sure you have the right+-- scope in your 'app' on dropbox: https://www.dropbox.com/developers/apps/info/t282kls5wbrtofs#permissions+-- then regenerate your token (because it's attached to that)+data Dropbox route = Dropbox+  -- TODO: implement list folder+  -- | https://www.dropbox.com/developers/documentation/http/documentation#files-list_folder+  { _dropbox_list_folder :: route :- "2" :> "files" :> "list_folder" :> Auth '[Bearer] Token :> ReqBody '[JSON] ListFolderRequest :> Post '[JSON] ListFolderResponse+  -- | https://www.dropbox.com/developers/documentation/http/documentation#files-get_temporary_link+  , _dropbox_get_temporary_link :: route :- "2" :> "files" :> "get_temporary_link" :> Auth '[Bearer] Token :> ReqBody '[JSON] LinkRequest :> Post '[JSON] LinkResponse+  , _dropbox_token :: route :- "oauth2" :> "token" :> ReqBody '[FormUrlEncoded] TokenBody :> Post '[JSON] TokenRequest+  } deriving Generic++-- does the generic to type level compute+dropboxProxy :: Proxy (ToServant Dropbox AsApi)+dropboxProxy = genericApi (Proxy @Dropbox)++-- | gives an adhoc client. This throws exceptions+cliRoutes ::  ClientEnv -> Dropbox (AsClientT IO)+cliRoutes env = genericClientHoist+    (\x -> runClientM x env >>= either throwIO return)++createClient :: IO (Dropbox (AsClientT IO))+createClient = do+  baseUri <- parseBaseUrl "https://api.dropboxapi.com/"+  manager <- newTlsManager+  pure $ cliRoutes $ mkClientEnv manager baseUri

@@ -0,0 +1,91 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++module DropboxSpec+  ( spec+  ) where++import Dropbox+import Data.Aeson.QQ+import Data.Aeson+import Test.Hspec++spec :: Spec+spec = do+  describe "Dropbox aeson aeson" $ do+    it "encodes list folder correctly" $+      encode defListFolderRequest `shouldBe` "{\"include_non_downloadable_files\":false,\"path\":\"\",\"include_mounted_folders\":true,\"include_deleted\":false,\"include_media_info\":false,\"include_has_explicit_shared_members\":false,\"recursive\":false}"+  describe "Example response" $ do+    it "Decodes correctly" $ fromJSON yyy `shouldBe` Success (ListFolderResponse+      [ Entry { eTag = File, eName = "Prime_Numbers.txt", ePathDisplay = "/Homework/math/Prime_Numbers.txt", eId = "id:a4ayc_80_OEAAAAAAAAAXw" }+      , Entry { eTag = Folder, eName = "math", ePathDisplay = "/Homework/math", eId = "id:a4ayc_80_OEAAAAAAAAAXz" }+      ])++yyy :: Value+yyy = [aesonQQ|+{+    "entries": [+        {+            ".tag": "file",+            "name": "Prime_Numbers.txt",+            "id": "id:a4ayc_80_OEAAAAAAAAAXw",+            "client_modified": "2015-05-12T15:50:38Z",+            "server_modified": "2015-05-12T15:50:38Z",+            "rev": "a1c10ce0dd78",+            "size": 7212,+            "path_lower": "/homework/math/prime_numbers.txt",+            "path_display": "/Homework/math/Prime_Numbers.txt",+            "sharing_info": {+                "read_only": true,+                "parent_shared_folder_id": "84528192421",+                "modified_by": "dbid:AAH4f99T0taONIb-OurWxbNQ6ywGRopQngc"+            },+            "is_downloadable": true,+            "property_groups": [+                {+                    "template_id": "ptid:1a5n2i6d3OYEAAAAAAAAAYa",+                    "fields": [+                        {+                            "name": "Security Policy",+                            "value": "Confidential"+                        }+                    ]+                }+            ],+            "has_explicit_shared_members": false,+            "content_hash": "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855",+            "file_lock_info": {+                "is_lockholder": true,+                "lockholder_name": "Imaginary User",+                "created": "2015-05-12T15:50:38Z"+            }+        },+        {+            ".tag": "folder",+            "name": "math",+            "id": "id:a4ayc_80_OEAAAAAAAAAXz",+            "path_lower": "/homework/math",+            "path_display": "/Homework/math",+            "sharing_info": {+                "read_only": false,+                "parent_shared_folder_id": "84528192421",+                "traverse_only": false,+                "no_access": false+            },+            "property_groups": [+                {+                    "template_id": "ptid:1a5n2i6d3OYEAAAAAAAAAYa",+                    "fields": [+                        {+                            "name": "Security Policy",+                            "value": "Confidential"+                        }+                    ]+                }+            ]+        }+    ],+    "cursor": "ZtkX9_EHj3x7PMkVuFIhwKYXEpwpLwyxp9vMKomUhllil9q7eWiAu",+    "has_more": false+}+|]

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -0,0 +1,16 @@+module Test.TestSpec+  ( spec+  )+where++import           Test.Hspec++one :: Int+one = 1++spec :: Spec+spec =+  describe "The sanity of our test setup"+    $          it "should satisfy equality"+    $          one+    `shouldBe` 1