├── .github └── workflows │ └── haskell.yml ├── .gitignore ├── .stylish-haskell.yaml ├── CHANGELOG.md ├── LICENSE ├── Makefile ├── README.md ├── app └── Main.hs ├── cabal.project.freeze ├── etc └── notion-cli.conf ├── hie.yaml ├── notion-cli.cabal ├── src ├── Notion │ ├── GetUploadFileUrl.hs │ ├── GetUserAnalyticsSettings.hs │ ├── SubmitTransaction.hs │ └── SubmitTransaction │ │ └── Operation.hs └── S3 │ └── Put.hs └── test └── Spec.hs /.github/workflows/haskell.yml: -------------------------------------------------------------------------------- 1 | name: Haskell CI 2 | 3 | env: 4 | ghc_version: 9.2.5 5 | cabal_version: 3.6.2.0 6 | 7 | on: 8 | workflow_dispatch: 9 | push: 10 | branches: [ master ] 11 | pull_request: 12 | branches: [ master ] 13 | 14 | jobs: 15 | build: 16 | 17 | runs-on: ubuntu-latest 18 | 19 | steps: 20 | - uses: actions/checkout@v2 21 | - uses: haskell/actions/setup@v2 22 | with: 23 | ghc-version: ${{ env.ghc_version }} 24 | cabal-version: ${{ env.cabal_version }} 25 | 26 | - name: Cache 27 | uses: actions/cache@v3 28 | with: 29 | path: ~/.cabal 30 | key: cabal-${{ hashFiles('cabal.project.freeze') }} 31 | restore-keys: cabal- 32 | - name: Install formatters 33 | run: | 34 | cabal update 35 | cabal install --overwrite-policy=always cabal-fmt stylish-haskell 36 | echo "$HOME/.cabal/bin" >> $GITHUB_PATH 37 | - name: Check format 38 | run: | 39 | make fmt 40 | if [[ -z "$(git status --porcelain)" ]]; then 41 | echo "No non-formatted file." 42 | else 43 | echo "Non-formatted files:" 44 | git --no-pager diff 45 | exit 1 46 | fi 47 | - name: Build 48 | run: | 49 | cabal update 50 | cabal build 51 | - name: Run tests 52 | run: cabal test all 53 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | dist-newstyle/ 3 | notion-cli 4 | *~ 5 | -------------------------------------------------------------------------------- /.stylish-haskell.yaml: -------------------------------------------------------------------------------- 1 | # stylish-haskell configuration file 2 | # ================================== 3 | 4 | # The stylish-haskell tool is mainly configured by specifying steps. These steps 5 | # are a list, so they have an order, and one specific step may appear more than 6 | # once (if needed). Each file is processed by these steps in the given order. 7 | steps: 8 | # Convert some ASCII sequences to their Unicode equivalents. This is disabled 9 | # by default. 10 | # - unicode_syntax: 11 | # # In order to make this work, we also need to insert the UnicodeSyntax 12 | # # language pragma. If this flag is set to true, we insert it when it's 13 | # # not already present. You may want to disable it if you configure 14 | # # language extensions using some other method than pragmas. Default: 15 | # # true. 16 | # add_language_pragma: true 17 | 18 | # Format record definitions. This is disabled by default. 19 | # 20 | # You can control the layout of record fields. The only rules that can't be configured 21 | # are these: 22 | # 23 | # - "|" is always aligned with "=" 24 | # - "," in fields is always aligned with "{" 25 | # - "}" is likewise always aligned with "{" 26 | # 27 | # - records: 28 | # # How to format equals sign between type constructor and data constructor. 29 | # # Possible values: 30 | # # - "same_line" -- leave "=" AND data constructor on the same line as the type constructor. 31 | # # - "indent N" -- insert a new line and N spaces from the beginning of the next line. 32 | # equals: "indent 2" 33 | # 34 | # # How to format first field of each record constructor. 35 | # # Possible values: 36 | # # - "same_line" -- "{" and first field goes on the same line as the data constructor. 37 | # # - "indent N" -- insert a new line and N spaces from the beginning of the data constructor 38 | # first_field: "indent 2" 39 | # 40 | # # How many spaces to insert between the column with "," and the beginning of the comment in the next line. 41 | # field_comment: 2 42 | # 43 | # # How many spaces to insert before "deriving" clause. Deriving clauses are always on separate lines. 44 | # deriving: 2 45 | 46 | # Align the right hand side of some elements. This is quite conservative 47 | # and only applies to statements where each element occupies a single 48 | # line. All default to true. 49 | - simple_align: 50 | cases: true 51 | top_level_patterns: true 52 | records: true 53 | 54 | # Import cleanup 55 | - imports: 56 | # There are different ways we can align names and lists. 57 | # 58 | # - global: Align the import names and import list throughout the entire 59 | # file. 60 | # 61 | # - file: Like global, but don't add padding when there are no qualified 62 | # imports in the file. 63 | # 64 | # - group: Only align the imports per group (a group is formed by adjacent 65 | # import lines). 66 | # 67 | # - none: Do not perform any alignment. 68 | # 69 | # Default: global. 70 | align: global 71 | 72 | # The following options affect only import list alignment. 73 | # 74 | # List align has following options: 75 | # 76 | # - after_alias: Import list is aligned with end of import including 77 | # 'as' and 'hiding' keywords. 78 | # 79 | # > import qualified Data.List as List (concat, foldl, foldr, head, 80 | # > init, last, length) 81 | # 82 | # - with_alias: Import list is aligned with start of alias or hiding. 83 | # 84 | # > import qualified Data.List as List (concat, foldl, foldr, head, 85 | # > init, last, length) 86 | # 87 | # - with_module_name: Import list is aligned `list_padding` spaces after 88 | # the module name. 89 | # 90 | # > import qualified Data.List as List (concat, foldl, foldr, head, 91 | # init, last, length) 92 | # 93 | # This is mainly intended for use with `pad_module_names: false`. 94 | # 95 | # > import qualified Data.List as List (concat, foldl, foldr, head, 96 | # init, last, length, scanl, scanr, take, drop, 97 | # sort, nub) 98 | # 99 | # - new_line: Import list starts always on new line. 100 | # 101 | # > import qualified Data.List as List 102 | # > (concat, foldl, foldr, head, init, last, length) 103 | # 104 | # Default: after_alias 105 | list_align: after_alias 106 | 107 | # Right-pad the module names to align imports in a group: 108 | # 109 | # - true: a little more readable 110 | # 111 | # > import qualified Data.List as List (concat, foldl, foldr, 112 | # > init, last, length) 113 | # > import qualified Data.List.Extra as List (concat, foldl, foldr, 114 | # > init, last, length) 115 | # 116 | # - false: diff-safe 117 | # 118 | # > import qualified Data.List as List (concat, foldl, foldr, init, 119 | # > last, length) 120 | # > import qualified Data.List.Extra as List (concat, foldl, foldr, 121 | # > init, last, length) 122 | # 123 | # Default: true 124 | pad_module_names: true 125 | 126 | # Long list align style takes effect when import is too long. This is 127 | # determined by 'columns' setting. 128 | # 129 | # - inline: This option will put as much specs on same line as possible. 130 | # 131 | # - new_line: Import list will start on new line. 132 | # 133 | # - new_line_multiline: Import list will start on new line when it's 134 | # short enough to fit to single line. Otherwise it'll be multiline. 135 | # 136 | # - multiline: One line per import list entry. 137 | # Type with constructor list acts like single import. 138 | # 139 | # > import qualified Data.Map as M 140 | # > ( empty 141 | # > , singleton 142 | # > , ... 143 | # > , delete 144 | # > ) 145 | # 146 | # Default: inline 147 | long_list_align: inline 148 | 149 | # Align empty list (importing instances) 150 | # 151 | # Empty list align has following options 152 | # 153 | # - inherit: inherit list_align setting 154 | # 155 | # - right_after: () is right after the module name: 156 | # 157 | # > import Vector.Instances () 158 | # 159 | # Default: inherit 160 | empty_list_align: inherit 161 | 162 | # List padding determines indentation of import list on lines after import. 163 | # This option affects 'long_list_align'. 164 | # 165 | # - : constant value 166 | # 167 | # - module_name: align under start of module name. 168 | # Useful for 'file' and 'group' align settings. 169 | # 170 | # Default: 4 171 | list_padding: 4 172 | 173 | # Separate lists option affects formatting of import list for type 174 | # or class. The only difference is single space between type and list 175 | # of constructors, selectors and class functions. 176 | # 177 | # - true: There is single space between Foldable type and list of it's 178 | # functions. 179 | # 180 | # > import Data.Foldable (Foldable (fold, foldl, foldMap)) 181 | # 182 | # - false: There is no space between Foldable type and list of it's 183 | # functions. 184 | # 185 | # > import Data.Foldable (Foldable(fold, foldl, foldMap)) 186 | # 187 | # Default: true 188 | separate_lists: true 189 | 190 | # Space surround option affects formatting of import lists on a single 191 | # line. The only difference is single space after the initial 192 | # parenthesis and a single space before the terminal parenthesis. 193 | # 194 | # - true: There is single space associated with the enclosing 195 | # parenthesis. 196 | # 197 | # > import Data.Foo ( foo ) 198 | # 199 | # - false: There is no space associated with the enclosing parenthesis 200 | # 201 | # > import Data.Foo (foo) 202 | # 203 | # Default: false 204 | space_surround: false 205 | 206 | # Language pragmas 207 | - language_pragmas: 208 | # We can generate different styles of language pragma lists. 209 | # 210 | # - vertical: Vertical-spaced language pragmas, one per line. 211 | # 212 | # - compact: A more compact style. 213 | # 214 | # - compact_line: Similar to compact, but wrap each line with 215 | # `{-#LANGUAGE #-}'. 216 | # 217 | # Default: vertical. 218 | style: vertical 219 | 220 | # Align affects alignment of closing pragma brackets. 221 | # 222 | # - true: Brackets are aligned in same column. 223 | # 224 | # - false: Brackets are not aligned together. There is only one space 225 | # between actual import and closing bracket. 226 | # 227 | # Default: true 228 | align: true 229 | 230 | # stylish-haskell can detect redundancy of some language pragmas. If this 231 | # is set to true, it will remove those redundant pragmas. Default: true. 232 | remove_redundant: true 233 | 234 | # Language prefix to be used for pragma declaration, this allows you to 235 | # use other options non case-sensitive like "language" or "Language". 236 | # If a non correct String is provided, it will default to: LANGUAGE. 237 | language_prefix: LANGUAGE 238 | 239 | # Replace tabs by spaces. This is disabled by default. 240 | # - tabs: 241 | # # Number of spaces to use for each tab. Default: 8, as specified by the 242 | # # Haskell report. 243 | # spaces: 8 244 | 245 | # Remove trailing whitespace 246 | - trailing_whitespace: {} 247 | 248 | # Squash multiple spaces between the left and right hand sides of some 249 | # elements into single spaces. Basically, this undoes the effect of 250 | # simple_align but is a bit less conservative. 251 | # - squash: {} 252 | 253 | # A common setting is the number of columns (parts of) code will be wrapped 254 | # to. Different steps take this into account. 255 | # 256 | # Set this to null to disable all line wrapping. 257 | # 258 | # Default: 80. 259 | columns: 80 260 | 261 | # By default, line endings are converted according to the OS. You can override 262 | # preferred format here. 263 | # 264 | # - native: Native newline format. CRLF on Windows, LF on other OSes. 265 | # 266 | # - lf: Convert to LF ("\n"). 267 | # 268 | # - crlf: Convert to CRLF ("\r\n"). 269 | # 270 | # Default: native. 271 | newline: native 272 | 273 | # Sometimes, language extensions are specified in a cabal file or from the 274 | # command line instead of using language pragmas in the file. stylish-haskell 275 | # needs to be aware of these, so it can parse the file correctly. 276 | # 277 | # No language extensions are enabled by default. 278 | # language_extensions: 279 | # - TemplateHaskell 280 | # - QuasiQuotes 281 | 282 | # Attempt to find the cabal file in ancestors of the current directory, and 283 | # parse options (currently only language extensions) from that. 284 | # 285 | # Default: true 286 | cabal: true 287 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for notion-cli-hs 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2021 kurubushi 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be included 12 | in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 17 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 18 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 19 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 20 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: fmt cabal-fmt src-fmt 2 | .PHONY: install 3 | 4 | ROOTDIR := . 5 | APP_HS_FILES := $(shell find $(ROOTDIR)/app -type f -name "*.hs") 6 | SRC_HS_FILES := $(shell find $(ROOTDIR)/src -type f -name "*.hs") 7 | GHC_VERSION := 9.2.5 8 | CABAL_VERSION := 3.6.2.0 9 | 10 | fmt: cabal-fmt src-fmt 11 | 12 | cabal-fmt: *.cabal 13 | cabal-fmt -i $^ 14 | 15 | src-fmt: $(APP_HS_FILES) $(SRC_HS_FILES) 16 | stylish-haskell -ri $^ 17 | 18 | ghc: 19 | ghcup install ghc $(GHC_VERSION) 20 | 21 | cabal: 22 | ghcup install cabal $(CABAL_VERSION) 23 | 24 | notion-cli: ghc cabal $(APP_HS_FILES) $(SRC_HS_FILES) 25 | cabal update 26 | cabal build -w ghc-$(GHC_VERSION) 27 | cabal install \ 28 | --installdir=. \ 29 | --install-method=copy \ 30 | --overwrite-policy=always \ 31 | exe:notion-cli 32 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # notion-cli-hs 2 | 3 | ## install 4 | 5 | Install [GHCup](https://www.haskell.org/ghcup/) and set PATH: 6 | 7 | ```bash 8 | export PATH=$HOME/.ghcup/bin:$PATH 9 | ``` 10 | 11 | Build a binary. 12 | 13 | ```bash 14 | git clone git@github.com:kurubushi/notion-cli-hs.git 15 | cd notion-cli-hs 16 | make notion-cli 17 | ``` 18 | 19 | Install the created binary `./notion-cli`. For instance: 20 | 21 | ```bash 22 | sudo install -Dm755 notion-cli /usr/local/bin 23 | export PATH=/usr/local/bin:$PATH 24 | ``` 25 | 26 | ## setup 27 | 28 | Create a config file `~/.notion-cli.conf`: 29 | 30 | ``` 31 | [Cookie] 32 | token_v2 = xxxxxxxxxx 33 | ``` 34 | 35 | ## usage 36 | 37 | ### Upload files to a Database on Notion. 38 | 39 | Obtain the UUID of a database from Network logs on user's web browser. 40 | When a user accesses a database page, a JSON data is sent to the server. 41 | 42 | For instance, a POST packet to https://www.notion.so/api/v3/queryCollection with 43 | 44 | ```json 45 | { 46 | "collectionId": "xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx", 47 | "collectionViewId": "yyyyyyyy-yyyy-yyyy-yyyy-yyyyyyyyyyyy", 48 | "query": {}, 49 | "loader": { 50 | "type": "table", 51 | "limit": 50, 52 | "searchQuery": "", 53 | "userTimeZone": "Asia/Tokyo", 54 | "loadContentCover": true 55 | } 56 | } 57 | ``` 58 | 59 | is found. The `collectionId` is the UUID of the database. 60 | 61 | Upload files to the database: 62 | 63 | ```bash 64 | notion-cli upload --database-uuid xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx --record-title pinogon pino.jpg gongon.jpg 65 | ``` 66 | 67 | The command inserts a new record "pinogon" to the database and appends pino.jpg and gongon.jpg to the record page. 68 | Check your database :+1: 69 | 70 | ### Upload files to a page on Notion. 71 | 72 | Upload files to the page https://www.notion.so/user-name/page_title-xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 73 | 74 | ```bash 75 | notion-cli upload --page-url https://www.notion.so/user-name/page_title-xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx pino.jpg gongon.jpg 76 | ``` 77 | 78 | The command appends pino.jpg and gongon.jpg to the page. 79 | 80 | ### Upload a file to S3 bucket. 81 | 82 | Upload a file to S3: 83 | 84 | ```bash 85 | notion-cli s3upload gongon.jpg 86 | ``` 87 | 88 | response: 89 | 90 | ``` 91 | File: gongon.jpg 92 | URL: "https://s3-us-west-2.amazonaws.com/secure.notion-static.com/xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx/gongon.jpg" 93 | ``` 94 | 95 | Embed the URL into an image block on Notion :+1: 96 | -------------------------------------------------------------------------------- /app/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards #-} 2 | 3 | module Main where 4 | 5 | import Control.Monad (forM_) 6 | import Data.Char (isHexDigit) 7 | import Data.ConfigFile (ConfigParser (..), emptyCP, get, 8 | readfile) 9 | import Data.Maybe (fromMaybe) 10 | import Notion.GetUploadFileUrl (getS3SignedPutURL, getS3URL, 11 | getUploadFileUrl) 12 | import Notion.SubmitTransaction (appendRecord, appendS3File, 13 | appendText) 14 | import Options.Applicative 15 | import S3.Put (putFile) 16 | import System.Directory (getHomeDirectory) 17 | import System.Exit (die) 18 | import System.FilePath.Posix (takeFileName) 19 | 20 | type UUID = String 21 | type URL = String 22 | 23 | getUUID :: URL -> Maybe UUID 24 | getUUID = format . takeLastHex . dropID 25 | where 26 | dropID = takeWhile (/= '#') 27 | takeLastHex = reverse . takeWhile isHexDigit . reverse 28 | format st = if length st == 32 29 | then Just $ slice 0 8 st ++ "-" 30 | ++ slice 8 12 st ++ "-" 31 | ++ slice 12 16 st ++ "-" 32 | ++ slice 16 20 st ++ "-" 33 | ++ slice 20 32 st 34 | else Nothing 35 | slice n m = take (m - n) . drop n 36 | 37 | newtype Environment = Environment { homeDir :: FilePath } 38 | deriving (Show, Eq) 39 | 40 | getEnvironment :: IO Environment 41 | getEnvironment = do 42 | homeDir <- getHomeDirectory 43 | return Environment{..} 44 | 45 | 46 | newtype Config = Config { tokenV2 :: String } 47 | deriving (Show, Eq, Read) 48 | 49 | defaultConfigFile :: FilePath -> FilePath 50 | defaultConfigFile home = home ++ "/.notion-cli.conf" 51 | 52 | getConfig :: FilePath -> IO Config 53 | getConfig filePath = do 54 | let handle e = die $ "invalid configration file\n" ++ show e 55 | val <- readfile emptyCP{optionxform = id} filePath 56 | either handle return $ do 57 | cp <- val 58 | tokenV2 <- get cp "Cookie" "token_v2" 59 | return Config{..} 60 | 61 | 62 | data ParentUUID = DBUUID UUID 63 | | PageUUID UUID 64 | | PageURL URL 65 | deriving (Show, Eq) 66 | 67 | data Options = S3UploadOpts { s3UploadConfigFilePath :: Maybe FilePath 68 | , s3UploadFilePath :: FilePath } 69 | | UploadOpts { uploadUUID :: ParentUUID 70 | , uploadRecordTitle :: Maybe String 71 | , uploadConfigFilePath :: Maybe FilePath 72 | , uploadDesc :: Maybe String 73 | , uploadFilePathes :: [FilePath] 74 | } 75 | | AppendTextOpts { appendTextUUID :: ParentUUID 76 | , appendTextRecordTitle :: Maybe String 77 | , appendTextConfigFilePath :: Maybe FilePath 78 | , appendTextContent :: String 79 | } 80 | deriving (Show, Eq) 81 | 82 | s3UploadOptions :: Parser Options 83 | s3UploadOptions = S3UploadOpts 84 | <$> (optional . strOption) (long "config-file" <> metavar "FILE" <> help "Set an alternative config file") 85 | <*> argument str (metavar "FILE" <> help "Select a file to upload") 86 | 87 | parentUUID :: Parser ParentUUID 88 | parentUUID = dbUUID <|> pageUUID <|> pageURL 89 | where 90 | dbUUID = DBUUID <$> strOption (long "database-uuid" <> metavar "UUID" <> help "Set the UUID of a database") 91 | pageUUID = PageUUID <$> strOption (long "page-uuid" <> metavar "UUID" <> help "Set the UUID of a page") 92 | pageURL = PageURL <$> strOption (long "page-url" <> metavar "URL" <> help "Set the URL of a page") 93 | 94 | uploadOptions :: Parser Options 95 | uploadOptions = UploadOpts 96 | <$> parentUUID 97 | <*> (optional . strOption) (long "record-title" <> metavar "TITLE" <> help "Set the Title of a created new record") 98 | <*> (optional . strOption) (long "config-file" <> metavar "FILE" <> help "Set an alternative config file") 99 | <*> (optional . strOption) (long "description" <> metavar "TEXT" <> help "Set a description of files") 100 | <*> (some . argument str) (metavar "FILES" <> help "Select files to upload") 101 | 102 | appendTextOptions :: Parser Options 103 | appendTextOptions = AppendTextOpts 104 | <$> parentUUID 105 | <*> (optional . strOption) (long "record-title" <> metavar "TITLE" <> help "Set the Title of a created new record") 106 | <*> (optional . strOption) (long "config-file" <> metavar "FILE" <> help "Set an alternative config file") 107 | <*> argument str (metavar "TEXT" <> help "Text to upload") 108 | 109 | options :: Parser Options 110 | options = subparser 111 | ( command "s3upload" (withInfo s3UploadOptions "s3upload" "Upload a file to S3") 112 | <> command "upload" (withInfo uploadOptions "upload" "Upload a file to a database") 113 | <> command "append-text" (withInfo appendTextOptions "append-text" "Append a text to a page") 114 | ) 115 | 116 | withInfo :: Parser a -> String -> String -> ParserInfo a 117 | withInfo opts name desc = info 118 | (helper <*> opts) 119 | (fullDesc <> header desc' <> progDesc desc) 120 | where 121 | desc' = "notion-cli " ++ name' ++ "- " ++ desc 122 | name' = if name == "" then name ++ " " else "" 123 | 124 | 125 | exec :: Environment -> Options -> IO () 126 | exec env S3UploadOpts {..} = do 127 | conf <- getConfig $ fromMaybe (defaultConfigFile . homeDir $ env) s3UploadConfigFilePath 128 | s3URLs <- getUploadFileUrl (tokenV2 conf) s3UploadFilePath 129 | _ <- putFile (getS3SignedPutURL s3URLs) s3UploadFilePath 130 | 131 | putStrLn $ "File: " ++ s3UploadFilePath 132 | putStrLn $ "URL: " ++ show (getS3URL s3URLs) 133 | 134 | exec env UploadOpts {..} = do 135 | conf <- getConfig $ fromMaybe (defaultConfigFile . homeDir $ env) uploadConfigFilePath 136 | let token = tokenV2 conf 137 | 138 | parentUUID <- case uploadUUID of 139 | DBUUID uuid -> do 140 | let title = fromMaybe (takeFileName . head $ uploadFilePathes) uploadRecordTitle 141 | appendRecord token uuid title 142 | PageUUID uuid -> return uuid 143 | PageURL url -> maybe (die "the page URL is invalid") return (getUUID url) 144 | 145 | forM_ uploadDesc (appendText token parentUUID) 146 | 147 | forM_ uploadFilePathes $ \filePath -> do 148 | s3URLs <- getUploadFileUrl token filePath 149 | let signedPutURL = getS3SignedPutURL s3URLs 150 | let url = getS3URL s3URLs 151 | _ <- putFile signedPutURL filePath 152 | _ <- appendS3File token parentUUID url 153 | putStrLn $ "File: " ++ filePath 154 | putStrLn $ "S3URL: " ++ show url 155 | 156 | exec env AppendTextOpts {..} = do 157 | conf <- getConfig $ fromMaybe (defaultConfigFile . homeDir $ env) appendTextConfigFilePath 158 | let token = tokenV2 conf 159 | 160 | parentUUID <- case appendTextUUID of 161 | DBUUID uuid -> do 162 | let title = fromMaybe "" appendTextRecordTitle 163 | appendRecord token uuid title 164 | PageUUID uuid -> return uuid 165 | PageURL url -> maybe (die "the page URL is invalid") return (getUUID url) 166 | 167 | uuid <- appendText token parentUUID appendTextContent 168 | putStrLn $ "UUID: " ++ uuid 169 | return () 170 | 171 | main :: IO () 172 | main = do 173 | env <- getEnvironment 174 | opts <- execParser (withInfo options "" "Notion CLI") 175 | exec env opts 176 | -------------------------------------------------------------------------------- /cabal.project.freeze: -------------------------------------------------------------------------------- 1 | active-repositories: hackage.haskell.org:merge 2 | constraints: any.Cabal ==3.6.3.0, 3 | any.ConfigFile ==1.1.4, 4 | ConfigFile -buildtests, 5 | any.MissingH ==1.6.0.0, 6 | MissingH +network--ge-3_0_0, 7 | any.OneTuple ==0.3.1, 8 | any.QuickCheck ==2.14.2, 9 | QuickCheck -old-random +templatehaskell, 10 | any.StateVar ==1.2.2, 11 | any.aeson ==2.1.1.0, 12 | aeson -cffi +ordered-keymap, 13 | any.aeson-casing ==0.2.0.0, 14 | any.ansi-terminal ==0.11.4, 15 | ansi-terminal -example +win32-2-13-1, 16 | any.ansi-wl-pprint ==0.6.9, 17 | ansi-wl-pprint -example, 18 | any.appar ==0.1.8, 19 | any.array ==0.5.4.0, 20 | any.asn1-encoding ==0.9.6, 21 | any.asn1-parse ==0.9.5, 22 | any.asn1-types ==0.3.4, 23 | any.assoc ==1.0.2, 24 | any.async ==2.2.4, 25 | async -bench, 26 | any.attoparsec ==0.14.4, 27 | attoparsec -developer, 28 | any.base ==4.16.4.0, 29 | any.base-compat ==0.12.2, 30 | any.base-compat-batteries ==0.12.2, 31 | any.base-orphans ==0.8.7, 32 | any.base64-bytestring ==1.2.1.0, 33 | any.basement ==0.0.15, 34 | any.bifunctors ==5.5.14, 35 | bifunctors +semigroups +tagged, 36 | any.binary ==0.8.9.0 || ==0.8.9.1, 37 | any.bitvec ==1.1.3.0, 38 | bitvec -libgmp, 39 | any.blaze-builder ==0.4.2.2, 40 | any.byteorder ==1.0.4, 41 | any.bytestring ==0.11.3.1 || ==0.11.4.0, 42 | any.case-insensitive ==1.2.1.0, 43 | any.cereal ==0.5.8.3, 44 | cereal -bytestring-builder, 45 | any.colour ==2.3.6, 46 | any.comonad ==5.0.8, 47 | comonad +containers +distributive +indexed-traversable, 48 | any.conduit ==1.3.4.3, 49 | any.conduit-extra ==1.3.6, 50 | any.connection ==0.3.1, 51 | any.containers ==0.6.5.1, 52 | any.contravariant ==1.5.5, 53 | contravariant +semigroups +statevar +tagged, 54 | any.cookie ==0.4.6, 55 | any.cryptohash-md5 ==0.11.101.0, 56 | any.cryptohash-sha1 ==0.11.101.0, 57 | any.cryptonite ==0.30, 58 | cryptonite -check_alignment +integer-gmp -old_toolchain_inliner +support_aesni +support_deepseq -support_pclmuldq +support_rdrand -support_sse +use_target_attributes, 59 | any.data-array-byte ==0.1.0.1, 60 | any.data-default-class ==0.1.2.0, 61 | any.data-fix ==0.3.2, 62 | any.deepseq ==1.4.6.1, 63 | any.directory ==1.3.6.2 || ==1.3.8.0, 64 | any.distributive ==0.6.2.1, 65 | distributive +semigroups +tagged, 66 | any.dlist ==1.0, 67 | dlist -werror, 68 | any.entropy ==0.4.1.10, 69 | entropy -donotgetentropy, 70 | any.exceptions ==0.10.4, 71 | any.filepath ==1.4.2.2 || ==1.4.100.1, 72 | filepath -cpphs, 73 | any.generically ==0.1, 74 | any.ghc-bignum ==1.2, 75 | any.ghc-boot-th ==9.2.5, 76 | any.ghc-prim ==0.8.0, 77 | any.hashable ==1.4.2.0, 78 | hashable +integer-gmp -random-initial-seed, 79 | any.hourglass ==0.2.12, 80 | any.hsc2hs ==0.68.9, 81 | hsc2hs -in-ghc-tree, 82 | any.hslogger ==1.3.1.0, 83 | hslogger +network--gt-3_0_0, 84 | any.http-client ==0.7.13.1, 85 | http-client +network-uri, 86 | any.http-client-tls ==0.3.6.1, 87 | any.http-conduit ==2.3.8, 88 | http-conduit +aeson, 89 | any.http-types ==0.12.3, 90 | any.indexed-traversable ==0.1.2, 91 | any.indexed-traversable-instances ==0.1.1.1, 92 | any.integer-gmp ==1.1, 93 | any.integer-logarithms ==1.0.3.1, 94 | integer-logarithms -check-bounds +integer-gmp, 95 | any.iproute ==1.7.12, 96 | any.memory ==0.18.0, 97 | memory +support_bytestring +support_deepseq, 98 | any.mime-types ==0.1.1.0, 99 | any.mono-traversable ==1.0.15.3, 100 | any.mtl ==2.2.2, 101 | any.network ==3.1.2.7, 102 | network -devel, 103 | any.network-bsd ==2.8.1.0, 104 | any.network-info ==0.2.1, 105 | any.network-uri ==2.6.4.2, 106 | any.old-locale ==1.0.0.7, 107 | any.old-time ==1.1.0.3, 108 | any.optparse-applicative ==0.16.1.0, 109 | optparse-applicative +process, 110 | any.parsec ==3.1.15.0 || ==3.1.16.1, 111 | any.pem ==0.2.4, 112 | any.pretty ==1.1.3.6, 113 | any.primitive ==0.7.4.0, 114 | any.process ==1.6.16.0 || ==1.6.17.0, 115 | any.random ==1.2.1.1, 116 | any.regex-base ==0.94.0.2, 117 | any.regex-compat ==0.95.2.1, 118 | any.regex-posix ==0.96.0.1, 119 | regex-posix -_regex-posix-clib, 120 | any.resourcet ==1.3.0, 121 | any.rts ==1.0.2, 122 | any.safe-exceptions ==0.1.7.3, 123 | any.scientific ==0.3.7.0, 124 | scientific -bytestring-builder -integer-simple, 125 | any.semialign ==1.2.0.1, 126 | semialign +semigroupoids, 127 | any.semigroupoids ==5.3.7, 128 | semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers, 129 | any.socks ==0.6.1, 130 | any.split ==0.2.3.5, 131 | any.splitmix ==0.1.0.4, 132 | splitmix -optimised-mixer, 133 | any.stm ==2.5.0.2, 134 | any.streaming-commons ==0.2.2.5, 135 | streaming-commons -use-bytestring-builder, 136 | any.strict ==0.4.0.1, 137 | strict +assoc, 138 | any.tagged ==0.8.7, 139 | tagged +deepseq +transformers, 140 | any.template-haskell ==2.18.0.0, 141 | any.text ==1.2.5.0, 142 | text -developer, 143 | any.text-short ==0.1.5, 144 | text-short -asserts, 145 | any.th-abstraction ==0.4.5.0, 146 | any.th-compat ==0.1.4, 147 | any.these ==1.1.1.1, 148 | these +assoc, 149 | any.time ==1.11.1.1, 150 | any.time-compat ==1.9.6.1, 151 | time-compat -old-locale, 152 | any.tls ==1.6.0, 153 | tls +compat -hans +network, 154 | any.transformers ==0.5.6.2, 155 | any.transformers-compat ==0.7.2, 156 | transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, 157 | any.typed-process ==0.2.10.1, 158 | any.unix ==2.7.2.2 || ==2.8.0.0, 159 | any.unix-time ==0.4.8, 160 | any.unliftio-core ==0.2.1.0, 161 | any.unordered-containers ==0.2.19.1, 162 | unordered-containers -debug, 163 | any.uuid ==1.3.15, 164 | any.uuid-types ==1.0.5, 165 | any.vector ==0.13.0.0, 166 | vector +boundschecks -internalchecks -unsafechecks -wall, 167 | any.vector-algorithms ==0.9.0.1, 168 | vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks, 169 | any.vector-stream ==0.1.0.0, 170 | any.witherable ==0.4.2, 171 | any.x509 ==1.7.7, 172 | any.x509-store ==1.6.9, 173 | any.x509-system ==1.6.7, 174 | any.x509-validation ==1.6.12, 175 | any.zlib ==0.6.3.0, 176 | zlib -bundled-c-zlib -non-blocking-ffi -pkg-config 177 | index-state: hackage.haskell.org 2023-02-22T14:08:10Z 178 | -------------------------------------------------------------------------------- /etc/notion-cli.conf: -------------------------------------------------------------------------------- 1 | [Cookie] 2 | token_v2 = xxxxxxxxxxxxxxxxxxxxxxxxx 3 | -------------------------------------------------------------------------------- /hie.yaml: -------------------------------------------------------------------------------- 1 | cradle: 2 | cabal: 3 | - path: "src" 4 | component: "lib:notion-cli" 5 | 6 | - path: "app/Main.hs" 7 | component: "notion-cli:exe:notion-cli" 8 | -------------------------------------------------------------------------------- /notion-cli.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | name: notion-cli 3 | version: 0.1.0.0 4 | synopsis: 5 | 6 | -- A longer description of the package. 7 | -- description: 8 | homepage: 9 | 10 | -- A URL where users can report bugs. 11 | -- bug-reports: 12 | license: MIT 13 | license-file: LICENSE 14 | author: kurubushi 15 | maintainer: krbshi@gmail.com 16 | 17 | -- A copyright notice. 18 | -- copyright: 19 | category: Web 20 | extra-source-files: CHANGELOG.md 21 | 22 | library 23 | exposed-modules: 24 | Notion.GetUploadFileUrl 25 | Notion.GetUserAnalyticsSettings 26 | Notion.SubmitTransaction 27 | Notion.SubmitTransaction.Operation 28 | S3.Put 29 | 30 | -- Modules included in this library but not exported. 31 | -- other-modules: 32 | other-extensions: 33 | DeriveGeneric 34 | OverloadedStrings 35 | 36 | build-depends: 37 | , aeson >=2 && <3 38 | , aeson-casing ^>=0.2.0 39 | , base >=4.7 && <5 40 | , bytestring ^>=0.11.4 41 | , filepath >=1.4 && <2 42 | , http-conduit >=2.3 && <3 43 | , mime-types ^>=0.1.0 44 | , safe-exceptions ^>=0.1.7 45 | , text >=1.2 && <2 46 | , unix-time ^>=0.4.7 47 | , uuid >=1.3 && <2 48 | 49 | hs-source-dirs: src 50 | default-language: Haskell2010 51 | 52 | executable notion-cli 53 | main-is: Main.hs 54 | 55 | -- Modules included in this executable, other than Main. 56 | -- other-modules: 57 | other-extensions: 58 | DeriveGeneric 59 | OverloadedStrings 60 | 61 | build-depends: 62 | , base >=4.7 && <5 63 | , ConfigFile >=1.1 && <2 64 | , directory >=1.3 && <2 65 | , filepath >=1.4 && <2 66 | , notion-cli 67 | , optparse-applicative ^>=0.16.1 68 | 69 | hs-source-dirs: app 70 | default-language: Haskell2010 71 | -------------------------------------------------------------------------------- /src/Notion/GetUploadFileUrl.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | module Notion.GetUploadFileUrl where 5 | 6 | import Control.Exception.Safe (MonadThrow) 7 | import Control.Monad.IO.Class 8 | import Data.Aeson (FromJSON (..), ToJSON (..), 9 | genericParseJSON, genericToJSON) 10 | import Data.Aeson.Casing (aesonDrop, camelCase) 11 | import qualified Data.ByteString.Char8 as BC 12 | import Data.Text (Text) 13 | import qualified Data.Text as T 14 | import GHC.Generics (Generic) 15 | import Network.HTTP.Simple 16 | import System.FilePath.Posix (takeFileName) 17 | 18 | data ReqBody = 19 | ReqBody { _reqBucket :: Text 20 | , _reqContentType :: Text 21 | , _reqName :: Text 22 | } deriving (Eq, Show, Generic) 23 | 24 | instance ToJSON ReqBody where 25 | toJSON = genericToJSON $ aesonDrop 4 camelCase 26 | 27 | instance FromJSON ReqBody where 28 | parseJSON = genericParseJSON $ aesonDrop 4 camelCase 29 | 30 | simpleRequestBody :: String -> ReqBody 31 | simpleRequestBody filePath = 32 | ReqBody { _reqBucket = "secure" 33 | , _reqContentType = "" 34 | , _reqName = T.pack . takeFileName $ filePath } 35 | 36 | 37 | data ResBody = 38 | ResBody { _resUrl :: Text 39 | , _resSignedPutUrl :: Text 40 | } deriving (Eq, Show, Generic) 41 | 42 | instance ToJSON ResBody where 43 | toJSON = genericToJSON $ aesonDrop 4 camelCase 44 | 45 | instance FromJSON ResBody where 46 | parseJSON = genericParseJSON $ aesonDrop 4 camelCase 47 | 48 | getS3URL :: ResBody -> String 49 | getS3URL = T.unpack . _resUrl 50 | 51 | getS3SignedPutURL :: ResBody -> String 52 | getS3SignedPutURL = T.unpack . _resSignedPutUrl 53 | 54 | 55 | endpoint :: String 56 | endpoint = "https://www.notion.so/api/v3/getUploadFileUrl" 57 | 58 | userAgent :: String 59 | userAgent = "Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/102.0.0.0 Safari/537.36" 60 | 61 | getUploadFileUrl :: (MonadThrow m, MonadIO m) => String -> String -> m ResBody 62 | getUploadFileUrl token filePath = do 63 | req <- parseRequest endpoint 64 | let req' = setRequestMethod "POST" 65 | . setRequestHeader "Cookie" [BC.pack $ "token_v2=" ++ token] 66 | . setRequestHeader "User-Agent" [BC.pack userAgent] 67 | . setRequestBodyJSON (simpleRequestBody filePath) 68 | $ req 69 | res <- httpJSON req' 70 | return $ getResponseBody res 71 | -------------------------------------------------------------------------------- /src/Notion/GetUserAnalyticsSettings.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | module Notion.GetUserAnalyticsSettings where 5 | 6 | import Control.Exception.Safe (MonadThrow) 7 | import Control.Monad.IO.Class 8 | import Data.Aeson (FromJSON (..), ToJSON (..), 9 | genericParseJSON, genericToJSON) 10 | import Data.Aeson.Casing (aesonDrop, snakeCase) 11 | import qualified Data.ByteString.Char8 as BC 12 | import GHC.Generics (Generic) 13 | import Network.HTTP.Simple 14 | 15 | type UUID = String 16 | type URL = String 17 | type Token = String 18 | 19 | newtype ReqBody = ReqBody { _reqPlatform :: String 20 | } deriving (Eq, Show, Generic) 21 | 22 | instance ToJSON ReqBody where 23 | toJSON = genericToJSON $ aesonDrop 4 snakeCase 24 | 25 | defaultReqBody :: ReqBody 26 | defaultReqBody = ReqBody { _reqPlatform = "web" } 27 | 28 | newtype ResBody = ResBody { _resUserId :: UUID 29 | } deriving (Eq, Show, Generic) 30 | 31 | instance FromJSON ResBody where 32 | parseJSON = genericParseJSON $ aesonDrop 4 snakeCase 33 | 34 | endpoint :: URL 35 | endpoint = "https://www.notion.so/api/v3/getUserAnalyticsSettings" 36 | 37 | userAgent :: String 38 | userAgent = "Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/102.0.0.0 Safari/537.36" 39 | 40 | getUserID :: (MonadThrow m, MonadIO m) => Token -> m UUID 41 | getUserID token = do 42 | req <- parseRequest endpoint 43 | let req' = setRequestMethod "POST" 44 | . setRequestHeader "Cookie" [BC.pack $ "token_v2=" ++ token] 45 | . setRequestHeader "User-Agent" [BC.pack userAgent] 46 | . setRequestBodyJSON defaultReqBody 47 | $ req 48 | res <- httpJSON req' 49 | return . _resUserId . getResponseBody $ res 50 | -------------------------------------------------------------------------------- /src/Notion/SubmitTransaction.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | module Notion.SubmitTransaction where 5 | 6 | import Control.Exception.Safe (MonadThrow) 7 | import Control.Monad.IO.Class (MonadIO, liftIO) 8 | import Data.Aeson (Options (..), 9 | SumEncoding (..), 10 | ToJSON (..), encode, 11 | genericToJSON) 12 | import Data.Aeson.Casing (aesonDrop, snakeCase) 13 | import qualified Data.ByteString.Char8 as BC 14 | import qualified Data.Text as T 15 | import qualified Data.UnixTime as UT 16 | import qualified Data.UUID as UUID 17 | import qualified Data.UUID.V4 as UUIDv4 18 | import GHC.Generics (Generic) 19 | import Network.HTTP.Simple 20 | import Network.Mime (defaultMimeLookup) 21 | import Notion.GetUserAnalyticsSettings (getUserID) 22 | import Notion.SubmitTransaction.Operation (Arguments (..), 23 | Operation (..), URL, UUID) 24 | import qualified Notion.SubmitTransaction.Operation as Op 25 | 26 | type Token = String 27 | 28 | newtype ReqBody = ReqBody { _reqOperations :: [Operation] } 29 | deriving (Eq, Show, Generic) 30 | 31 | instance ToJSON ReqBody where 32 | toJSON = genericToJSON $ aesonDrop 4 snakeCase 33 | 34 | endpoint :: URL 35 | endpoint = "https://www.notion.so/api/v3/submitTransaction" 36 | 37 | userAgent :: String 38 | userAgent = "Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/102.0.0.0 Safari/537.36" 39 | 40 | genUUID :: MonadIO m => m UUID 41 | genUUID = UUID.toString <$> liftIO UUIDv4.nextRandom 42 | 43 | getUnixTime :: MonadIO m => m Int 44 | getUnixTime = do 45 | time <- liftIO UT.getUnixTime 46 | unixtime <- liftIO $ UT.formatUnixTime "%s" time 47 | return . read . BC.unpack $ unixtime 48 | 49 | post :: (MonadIO m, MonadThrow m) => Token -> [Operation] -> m () 50 | post token ops = do 51 | let body = ReqBody { _reqOperations = ops } 52 | req <- parseRequest endpoint 53 | let req' = setRequestMethod "POST" 54 | . setRequestHeader "Cookie" [BC.pack $ "token_v2=" ++ token] 55 | . setRequestHeader "User-Agent" [BC.pack userAgent] 56 | . setRequestBodyJSON body 57 | $ req 58 | httpNoBody req' 59 | return () 60 | 61 | appendRecord :: (MonadIO m, MonadThrow m) => Token -> UUID -> String -> m UUID 62 | appendRecord token collectionID recordTitle = do 63 | blockID <- genUUID 64 | userID <- getUserID token 65 | unixTime <- getUnixTime 66 | post token $ Op.appendRecord blockID userID unixTime collectionID recordTitle 67 | return blockID 68 | 69 | appendS3File :: (MonadIO m, MonadThrow m) => Token -> UUID -> URL -> m UUID 70 | appendS3File token pageID url = do 71 | blockID <- genUUID 72 | userID <- getUserID token 73 | unixTime <- getUnixTime 74 | post token $ Op.appendS3File blockID userID unixTime pageID url 75 | return blockID 76 | 77 | appendText :: (MonadIO m, MonadThrow m) => Token -> UUID -> String -> m UUID 78 | appendText token pageID content = do 79 | blockID <- genUUID 80 | userID <- getUserID token 81 | unixTime <- getUnixTime 82 | post token $ Op.appendText blockID userID unixTime pageID content 83 | return blockID 84 | -------------------------------------------------------------------------------- /src/Notion/SubmitTransaction/Operation.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | module Notion.SubmitTransaction.Operation 5 | (-- types 6 | URL 7 | , UUID 8 | , Operation(..) 9 | , Arguments(..) 10 | -- operations 11 | , defaultOperation 12 | , defaultArgumentsObj 13 | , updateWithdefaultProps 14 | , appendRecord 15 | , appendS3File 16 | , appendText 17 | ) where 18 | 19 | import Data.Aeson (Options (..), SumEncoding (..), 20 | ToJSON (..)) 21 | import qualified Data.Aeson as A 22 | import qualified Data.Aeson.Casing as AC 23 | import qualified Data.ByteString.Char8 as BC 24 | import qualified Data.Text as T 25 | import GHC.Generics (Generic) 26 | import qualified Network.Mime as Mime 27 | 28 | type URL = String 29 | type UUID = String 30 | 31 | data Operation = Operation 32 | { _opId :: UUID 33 | , _opTable :: String 34 | , _opPath :: [String] 35 | , _opCommand :: String 36 | , _opArgs :: Arguments 37 | } deriving (Eq, Show, Generic) 38 | 39 | instance ToJSON Operation where 40 | toJSON = A.genericToJSON $ AC.aesonDrop (length prefix) AC.snakeCase 41 | where 42 | prefix :: String 43 | prefix = "_op" 44 | 45 | data Arguments 46 | = ArgumentsObj 47 | { _argId :: Maybe UUID 48 | , _argType :: Maybe String 49 | , _argVersion :: Maybe Int 50 | , _argParentId :: Maybe UUID 51 | , _argParentTable :: Maybe String 52 | , _argAlive :: Maybe Bool 53 | , _argSource :: Maybe [[URL]] 54 | , _argDisplaySource :: Maybe URL 55 | } 56 | | ArgumentsList [[String]] 57 | | ArgumentString String 58 | | ArgumentInt Int 59 | deriving (Eq, Show, Generic) 60 | 61 | instance ToJSON Arguments where 62 | toJSON = A.genericToJSON 63 | $ (AC.aesonDrop (length prefix) AC.snakeCase) 64 | { omitNothingFields = True 65 | , sumEncoding = UntaggedValue 66 | } 67 | where 68 | prefix :: String 69 | prefix = "_arg" 70 | 71 | 72 | defaultOperation :: Operation 73 | defaultOperation = Operation 74 | { _opId = "" 75 | , _opTable = "block" 76 | , _opPath = [] 77 | , _opCommand = "set" 78 | , _opArgs = defaultArgumentsObj 79 | } 80 | 81 | defaultArgumentsObj :: Arguments 82 | defaultArgumentsObj = ArgumentsObj 83 | { _argId = Nothing 84 | , _argType = Nothing 85 | , _argVersion = Nothing 86 | , _argParentId = Nothing 87 | , _argParentTable = Nothing 88 | , _argAlive = Nothing 89 | , _argSource = Nothing 90 | , _argDisplaySource = Nothing 91 | } 92 | 93 | updateWithdefaultProps :: UUID -> UUID -> Int -> [Operation] 94 | updateWithdefaultProps blockID userID unixTime 95 | = [ createdBy 96 | , createdByTable 97 | , createdAt 98 | , editedBy 99 | , editedByTable 100 | , editedAt 101 | ] 102 | where 103 | time = unixTime * 1000 104 | set = defaultOperation { _opId = blockID, _opCommand = "set" } 105 | createdBy 106 | = set { _opPath = ["created_by_id"] 107 | , _opArgs = ArgumentString userID 108 | } 109 | createdByTable 110 | = set { _opPath = ["created_by_table"] 111 | , _opArgs = ArgumentString "notion_user" 112 | } 113 | createdAt 114 | = set { _opPath = ["created_time"] 115 | , _opArgs = ArgumentInt time 116 | } 117 | editedBy 118 | = set { _opPath = ["last_edited_by_id"] 119 | , _opArgs = ArgumentString userID 120 | } 121 | editedByTable 122 | = set { _opPath = ["last_edited_by_table"] 123 | , _opArgs = ArgumentString "notion_user" 124 | } 125 | editedAt 126 | = set { _opPath = ["last_edited_time"] 127 | , _opArgs = ArgumentInt time 128 | } 129 | 130 | appendRecord :: UUID -> UUID -> Int -> UUID -> String -> [Operation] 131 | appendRecord blockID userID unixTime collectionID recordTitle 132 | = [ createBlock 133 | , setTitle 134 | ] ++ updateWithdefaultProps blockID userID unixTime 135 | where 136 | createBlock 137 | = defaultOperation 138 | { _opId = blockID 139 | , _opCommand = "set" 140 | , _opArgs 141 | = defaultArgumentsObj 142 | { _argId = Just blockID 143 | , _argType = Just "page" 144 | , _argVersion = Just 1 145 | , _argParentId = Just collectionID 146 | , _argParentTable = Just "collection" 147 | , _argAlive = Just True 148 | } 149 | } 150 | setTitle 151 | = defaultOperation 152 | { _opId = blockID 153 | , _opCommand = "set" 154 | , _opPath = ["properties", "title"] 155 | , _opArgs = ArgumentsList [[recordTitle]] 156 | } 157 | 158 | appendS3File :: UUID -> UUID -> Int -> UUID -> URL -> [Operation] 159 | appendS3File blockID userID unixTime pageID url 160 | = [ createBlock 161 | , appendToPage 162 | , updateProp 163 | , updateFmt 164 | , registerS3File 165 | ] ++ updateWithdefaultProps blockID userID unixTime 166 | where 167 | createBlock 168 | = defaultOperation 169 | { _opId = blockID 170 | , _opCommand = "set" 171 | , _opArgs 172 | = defaultArgumentsObj 173 | { _argId = Just blockID 174 | , _argType = Just $ getBlockType url 175 | , _argVersion = Just 1 176 | , _argParentId = Just pageID 177 | , _argParentTable = Just "block" 178 | , _argAlive = Just True 179 | } 180 | } 181 | appendToPage 182 | = defaultOperation 183 | { _opId = pageID 184 | , _opCommand = "listAfter" 185 | , _opPath = ["content"] 186 | , _opArgs = defaultArgumentsObj { _argId = Just blockID } 187 | } 188 | updateProp 189 | = defaultOperation 190 | { _opId = blockID 191 | , _opPath = ["properties"] 192 | , _opCommand = "update" 193 | , _opArgs = defaultArgumentsObj { _argSource = Just [[url]] } 194 | } 195 | updateFmt 196 | = defaultOperation 197 | { _opId = blockID 198 | , _opPath = ["format"] 199 | , _opCommand = "update" 200 | , _opArgs = defaultArgumentsObj { _argDisplaySource = Just url } 201 | } 202 | registerS3File 203 | = defaultOperation 204 | { _opId = blockID 205 | , _opPath = ["file_ids"] 206 | , _opCommand = "listAfter" 207 | , _opArgs = defaultArgumentsObj { _argId = Just $ getS3FileID url } 208 | } 209 | 210 | getS3FileID :: URL -> UUID 211 | getS3FileID = takeWhile (/= '/') . drop (length s3URLPrefix) 212 | where 213 | s3URLPrefix :: URL 214 | s3URLPrefix = "https://s3-us-west-2.amazonaws.com/secure.notion-static.com/" 215 | 216 | getBlockType :: URL -> String 217 | getBlockType = conv . takeWhile (/= '/') . BC.unpack . Mime.defaultMimeLookup . T.pack 218 | where 219 | conv "image" = "image" 220 | conv "audio" = "audio" 221 | conv "video" = "video" 222 | conv _ = "file" 223 | 224 | appendText :: UUID -> UUID -> Int -> UUID -> String -> [Operation] 225 | appendText blockID userID unixTime pageID content 226 | = [ createBlock 227 | , appendToPage 228 | , updateContent 229 | ] ++ updateWithdefaultProps blockID userID unixTime 230 | where 231 | createBlock 232 | = defaultOperation 233 | { _opId = blockID 234 | , _opCommand = "set" 235 | , _opArgs 236 | = defaultArgumentsObj 237 | { _argId = Just blockID 238 | , _argType = Just "text" 239 | , _argVersion = Just 1 240 | , _argParentId = Just pageID 241 | , _argParentTable = Just "block" 242 | , _argAlive = Just True 243 | } 244 | } 245 | appendToPage 246 | = defaultOperation 247 | { _opId = pageID 248 | , _opCommand = "listAfter" 249 | , _opPath = ["content"] 250 | , _opArgs = defaultArgumentsObj { _argId = Just blockID } 251 | } 252 | updateContent 253 | = defaultOperation 254 | { _opId = blockID 255 | , _opCommand = "set" 256 | , _opPath = ["properties", "title"] 257 | , _opArgs = ArgumentsList [[content]] 258 | } 259 | -------------------------------------------------------------------------------- /src/S3/Put.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module S3.Put where 4 | 5 | import Control.Exception.Safe (MonadThrow) 6 | import Control.Monad.IO.Class 7 | import qualified Data.Text as T 8 | import Network.HTTP.Client.Conduit (ManagerSettings (..), 9 | defaultManagerSettings, 10 | newManagerSettings, 11 | responseTimeoutNone) 12 | import Network.HTTP.Simple 13 | import Network.Mime (defaultMimeLookup) 14 | 15 | putFile :: (MonadIO m, MonadThrow m) => String -> String -> m () 16 | putFile url filePath = do 17 | manager <- newManagerSettings 18 | $ defaultManagerSettings { managerResponseTimeout = responseTimeoutNone } 19 | 20 | req <- parseRequest url 21 | let req' = setRequestMethod "PUT" 22 | . setRequestHeader "Content-Type" [defaultMimeLookup $ T.pack filePath] 23 | . setRequestBodyFile filePath 24 | . setRequestManager manager 25 | $ req 26 | res <- httpNoBody req' 27 | return $ getResponseBody res 28 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "Test suite not yet implemented" 3 | --------------------------------------------------------------------------------