add uploadFile method. Update several tutorials

avatar29A · avatar29A · commit 9cc3fd1e4e9e · 2020-05-25T17:10:29.000+06:00
diff --git a/README.md b/README.md
@@ -39,6 +39,33 @@ main = do
         Right me -> print me
 ```
 
+### Upload File
+
+```haskell
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Network.HTTP.Client
+import Network.HTTP.Client.TLS (tlsManagerSettings)
+
+import qualified Data.ByteString.Lazy.Char8 as BC
+
+import Aitu.Bot
+
+main :: IO ()
+main = do
+    let token = "<YOUR_BOT_TOKEN>"
+
+    manager <- newManager tlsManagerSettings
+    response <- runAituBotClient token manager $ do 
+        uploadFile "cat.png" "images/cat.png"
+
+    case response of
+        Left (code, errMsg) -> BC.putStrLn errMsg
+        Right me -> print me
+```
+
 ### UI
 
 Simple Form with Button, that open url by click
@@ -148,7 +175,7 @@ where
 - [x] [setWebhook](https://btsdigital.github.io/bot-api-contract/setwebhook.html)
 - [x] [deleteWebhook](https://btsdigital.github.io/bot-api-contract/deletewebhook.html)
 - [x] [getWebhookInfo](https://btsdigital.github.io/bot-api-contract/getwebhookinfo.html)
-- [ ] uploadMedia
+- [x] uploadMedia
 - [ ] downloadMedia 
 
 ## Updates
@@ -202,4 +229,5 @@ where
     - [x] [Text](https://github.com/avatar29A/hs-aitubots-api/blob/master/src/Aitu/Bot/Forms/Content/TextWidget.hs)
     - [x] [TextArea](https://github.com/avatar29A/hs-aitubots-api/blob/master/src/Aitu/Bot/Forms/Content/TextArea.hs)
     - [x] [UserInfo](https://github.com/avatar29A/hs-aitubots-api/blob/master/src/Aitu/Bot/Forms/Content/UserInfo.hs)
-- [ ] Typed Resource Library
+- [ ] Typed Resource Library
+- [ ] Applicative Form Builder
diff --git a/hs-aitubots-api.cabal b/hs-aitubots-api.cabal
@@ -4,10 +4,10 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 4898caec675424a16affcf31fc3ca014386ee5b112cd117023ca4a9460451ff8
+-- hash: 3865539b4c858b77c3cffde6fbc910d5d6b80b6d6bb1a71e44d2885a74225f94
 
 name:           hs-aitubots-api
-version:        0.2.0.0
+version:        0.3.0.0
 description:    Please see the README on GitHub at <https://github.com/avatar29A/hs-aitubots-api/READMME.md>
 homepage:       https://github.com/avatar29A/hs-aitubots-api#readme
 bug-reports:    https://github.com/avatar29A/hs-aitubots-api/issues
@@ -91,6 +91,7 @@ library
       Aitu.Bot.Types.ReplyCommand
       Aitu.Bot.Types.UIState
       Aitu.Bot.Types.Updates
+      Aitu.Bot.Types.UploadFiles
       Aitu.Bot.Types.User
       Aitu.Bot.Types.Video
       Aitu.Bot.Types.WebHookInfo
diff --git a/package.yaml b/package.yaml
@@ -28,7 +28,7 @@ dependencies:
 - mtl
 - base >= 4.7 && < 5
 name: hs-aitubots-api
-version: 0.2.0.0
+version: 0.3.0.0
 extra-source-files:
 - README.md
 - ChangeLog.md
diff --git a/src/Aitu/Bot.hs b/src/Aitu/Bot.hs
@@ -15,6 +15,7 @@ module Aitu.Bot
     , setWebhook
     , getWebhook
     , deleteWebhook
+    , uploadFile
     )
 where
 
@@ -25,6 +26,7 @@ import           Control.Exception
 
 import           Network.HTTP.Client
 import           Network.HTTP.Types.Status      ( statusCode )
+import           Network.HTTP.Client.MultipartFormData
 
 import           Data.Aeson
 import           Data.UUID.Types               as UUID
@@ -51,6 +53,7 @@ type Url = String
 type Token = String
 type Method = BS.ByteString
 type JSON = BC.ByteString
+type FileName = T.Text
 
 type AituBotClient a = ReaderT AituBotConfig IO (Either ClientError a)
 
@@ -150,6 +153,38 @@ get' url = do
 post :: Url -> BC.ByteString -> AituBotClient BC.ByteString
 post = invoke "POST"
 
+uploadFile :: FileName -> FilePath -> AituBotClient UploadFiles
+uploadFile filename filepath = do
+    response <- uploadFiles filename filepath
+    pure (response >>= mkFromJSON)
+
+-- uploadFile uploads file to Aitu server
+uploadFiles :: FileName -> FilePath -> AituBotClient JSON
+uploadFiles filename filepath = do
+    t       <- asks token
+    baseUrl <- asks apiUrl
+    m       <- asks manager
+    let url = baseUrl <> "upload"
+
+    initReq <- liftIO $ parseRequest url
+    let request = initReq
+            { method         = "POST"
+            , requestHeaders = [ ("x-bot-token" , (encodeUtf8 . T.pack) t)
+                               , ("content-type", "application/octet-stream")
+                               ]
+            }
+
+    response <-
+        liftIO
+        $   flip httpLbs m
+        =<< formDataBody [partFileSource filename filepath] request
+
+    let httpCode = statusCode $ responseStatus response
+        body     = responseBody response
+
+    pure $ if httpCode /= 200 then Left (httpCode, body) else Right body
+
+
 -- invoke does http request to Aitu Bot Platform and returns raw data or Error.
 invoke :: Method -> Url -> JSON -> AituBotClient JSON
 invoke method endpoint json = do
diff --git a/src/Aitu/Bot/Types.hs b/src/Aitu/Bot/Types.hs
@@ -1,24 +1,31 @@
-module Aitu.Bot.Types (module Types) where
+module Aitu.Bot.Types
+    ( module Types
+    )
+where
 
 -- Types
-import Aitu.Bot.Types.Audio as Types
-import Aitu.Bot.Types.Avatar as Types
-import Aitu.Bot.Types.Bot as Types
-import Aitu.Bot.Types.Contact as Types
-import Aitu.Bot.Types.Document as Types
-import Aitu.Bot.Types.Errors as Types
-import Aitu.Bot.Types.ForwardMetadata as Types
-import Aitu.Bot.Types.Image as Types
-import Aitu.Bot.Types.InputMedia as Types
-import Aitu.Bot.Types.Media as Types
-import Aitu.Bot.Types.Peer as Types
-import Aitu.Bot.Types.UIState as Types
-import Aitu.Bot.Types.User as Types
-import Aitu.Bot.Types.Video as Types
-import Aitu.Bot.Types.WebHookInfo as Types
-import Aitu.Bot.Types.InlineCommand as Types
-import Aitu.Bot.Types.QuickButtonCommand as Types
-import Aitu.Bot.Types.ReplyCommand as Types
-import Aitu.Bot.Types.InputContact as Types
+import           Aitu.Bot.Types.Audio          as Types
+import           Aitu.Bot.Types.Avatar         as Types
+import           Aitu.Bot.Types.Bot            as Types
+import           Aitu.Bot.Types.Contact        as Types
+import           Aitu.Bot.Types.Document       as Types
+import           Aitu.Bot.Types.Errors         as Types
+import           Aitu.Bot.Types.ForwardMetadata
+                                               as Types
+import           Aitu.Bot.Types.Image          as Types
+import           Aitu.Bot.Types.InputMedia     as Types
+import           Aitu.Bot.Types.Media          as Types
+import           Aitu.Bot.Types.Peer           as Types
+import           Aitu.Bot.Types.UIState        as Types
+import           Aitu.Bot.Types.User           as Types
+import           Aitu.Bot.Types.Video          as Types
+import           Aitu.Bot.Types.WebHookInfo    as Types
+import           Aitu.Bot.Types.InlineCommand  as Types
+import           Aitu.Bot.Types.QuickButtonCommand
+                                               as Types
+import           Aitu.Bot.Types.ReplyCommand   as Types
+import           Aitu.Bot.Types.InputContact   as Types
 -- Updates
-import Aitu.Bot.Types.Updates as Types
+import           Aitu.Bot.Types.Updates        as Types
+-- Files
+import           Aitu.Bot.Types.UploadFiles    as Types
diff --git a/src/Aitu/Bot/Types/UploadFiles.hs b/src/Aitu/Bot/Types/UploadFiles.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Aitu.Bot.Types.UploadFiles
+    ( File(..)
+    , UploadFiles(..)
+    )
+where
+
+import           Data.Aeson
+import           Data.Text
+
+data File = File {
+    fileId :: Text
+    , fileName :: Text
+} deriving (Show)
+
+instance FromJSON File where
+    parseJSON (Object v) = File <$> v .: "fileId" <*> v .: "fileName"
+
+newtype UploadFiles = UploadFiles {
+    files :: [File]
+} deriving (Show)
+
+instance FromJSON UploadFiles where
+    parseJSON (Object v) = UploadFiles <$> v .: "uploadedFiles"
diff --git a/tutorials/.DS_Store b/tutorials/.DS_Store
diff --git a/tutorials/simpleui/.DS_Store b/tutorials/simpleui/.DS_Store
diff --git a/tutorials/simpleui/app/FormCustomContainer.hs b/tutorials/simpleui/app/FormCustomContainer.hs
@@ -4,7 +4,9 @@
 module FormCustomContainer where
 
 import           Aitu.Bot
-import           Aitu.Bot.Types
+import           Aitu.Bot.Types          hiding ( Image(..)
+                                                , InputMediaType(..)
+                                                )
 import           Aitu.Bot.Forms
 import           Aitu.Bot.Commands
 import           Aitu.Bot.Widgets
@@ -94,9 +96,38 @@ open peer = do
                 }
             }
 
+        image1 = Image
+            { contentId    = "image1"
+            , options      = Just defaultOptions
+                { width       = Just 37
+                , height      = Just 6
+                , flexOptions = Just defaultFlexOptions
+                                    { alignSelf = Just ALIGN_CENTER
+                                    }
+                }
+            , fileMetadata = FileMetadata
+                                 "435fa9e6-9e74-11ea-bfb9-82ed4a7ce3ac"
+                                 IMAGE
+                                 "cat.jpg"
+            , formAction   = Nothing
+            }
+
+        imageContainer = CustomContainer
+            { contentId = "imageContainer"
+            , content   = [C.Content image1]
+            , options   = Just defaultOptions
+                { width       = Just 62
+                , flexOptions = Just defaultFlexOptions
+                                    { flexDirection = Just COLUMN
+                                    , alignItems    = Just ALIGN_CENTER
+                                    }
+                }
+            }
+
         parentCustomContainer = CustomContainer
             { contentId = "parentContainer"
-            , content   = [ C.Content titleText
+            , content   = [ C.Content imageContainer
+                          , C.Content titleText
                           , C.Content subtitleText
                           , C.Content divider
                           , C.Content contactTitleText
@@ -125,4 +156,4 @@ open peer = do
             }
 
 
-    sendCustomContainer peer [mainCustomContainer]
+    sendCustomContainer peer [mainCustomContainer, mainCustomContainer]
diff --git a/tutorials/simpleui/app/FormImage.hs b/tutorials/simpleui/app/FormImage.hs
@@ -22,9 +22,11 @@ open peer = do
                         , formAction = Nothing
                         }
 
-        fileMetadata = FileMetadata "image_id" IMAGE "file_name.jpg"
+        fileMetadata = FileMetadata "435fa9e6-9e74-11ea-bfb9-82ed4a7ce3ac"
+                                    IMAGE
+                                    "cat.jpg"
 
-        image1       = Image
+        image1 = Image
             "image_id"
             fileMetadata
             (Just defaultOptions { width = Just 100, height = Just 100 })
diff --git a/tutorials/simpleui/app/Main.hs b/tutorials/simpleui/app/Main.hs
@@ -33,12 +33,12 @@ import qualified FormCustomContainer
 
 main :: IO ()
 main = do
-    let token  = "<BOT TOKEN>"
-        peerId = fromJust (UUID.fromString "<PEER ID>")
+    let token  = "API_BOT_TOKEN"
+        peerId = fromJust (UUID.fromString "PEER_ID")
         peer   = mkUserWithDefaults peerId
 
     manager  <- newManager tlsManagerSettings
-    response <- runAituBotClient token manager $ FormCustomContainer.open peer
+    response <- runAituBotClient token manager $ FormImage.open peer
 
     case response of
         Left  (code, errMsg) -> BC.putStrLn errMsg
diff --git a/tutorials/simpleui/images/cat.jpg b/tutorials/simpleui/images/cat.jpg
