feat(server): Domain ~ Repo

server/src/Api/Api.fsproj

@@ -1,12 +1,26 @@
 <Project Sdk="Microsoft.NET.Sdk.Web">
-
   <PropertyGroup>
     <TargetFramework>net8.0</TargetFramework>
     <LangVersion>preview</LangVersion>
   </PropertyGroup>
-
   <ItemGroup>
+    <Compile Include="Domain.fs" />
+    <Compile Include="Business\Persistence.fs" />
+    <Compile Include="Business\Infra.fs" />
+    <Compile Include="Business\CommandHandler.fs" />
+    <Compile Include="Repositories\ML.fs" />
+    <Compile Include="Repositories/GCS.fs" />
+    <Compile Include="Repositories\Database.fs" />
     <Compile Include="Program.fs" />
   </ItemGroup>
-
-</Project>
+  <ItemGroup>
+    <PackageReference Include="Dapper.FSharp" Version="4.7.0" />
+    <PackageReference Include="DotNetEnv" Version="2.5.0" />
+    <PackageReference Include="Falco" Version="4.0.4" />
+    <PackageReference Include="FsHttp" Version="11.0.0" />
+    <PackageReference Include="FsToolkit.ErrorHandling" Version="4.10.0" />
+    <PackageReference Include="FsToolkit.ErrorHandling.TaskResult" Version="4.10.0" />
+    <PackageReference Include="Google.Cloud.Storage.V1" Version="4.6.0" />
+    <PackageReference Include="MySql.Data" Version="8.2.0" />
+  </ItemGroup>
+</Project>

server/src/Api/Business/CommandHandler.fs

@@ -0,0 +1,57 @@
+module Application.CommandHandler
+
+open Domain.Types
+open Application.Persistence
+open Application.Infra
+open FsToolkit.ErrorHandling
+
+type CommandError =
+    | Domain of DomainError
+    | Persistence of PersistenceError
+    | Infra of InfraError
+
+type Repositories = {
+    imageInfo: ImageInfoRepo
+    rawImage: RawImageRepo
+    ml: MLService
+}
+
+let getImage (repos: Repositories) (id: Id) =
+    asyncResult {
+        let! image =
+            repos.imageInfo.retrieve id
+            |> AsyncResult.mapError Persistence
+
+        // return ImageRetrieved image
+        return image
+    }
+
+let saveImage (repos: Repositories) (base64: Base64) =
+    asyncResult {
+        let! obj =
+            repos.rawImage.upload base64
+            |> AsyncResult.mapError Persistence
+
+        let! image =
+            repos.imageInfo.register {
+                id = obj.Id
+                base64 = base64
+                url = obj.MediaLink
+            }
+            |> AsyncResult.mapError Persistence
+
+
+        return ImageSaved image
+    }
+
+let inference (repos: Repositories) (request: InferenceRequest) =
+    asyncResult {
+        let! result = repos.ml.inference request |> AsyncResult.mapError Infra
+        return InferenceCompleted result
+    }
+
+// let commandHandler (repos: Repositories) (command: Command) =
+//     match command with
+//     | GetImage id -> getImage repos.imageInfo id
+//     | SaveImage base64 -> saveImage repos.imageInfo repos.rawImage base64
+//     | Inference request -> inference repos.ml request

server/src/Api/Business/Infra.fs

@@ -0,0 +1,15 @@
+module Application.Infra
+
+open Domain.Types
+
+type InfraError =
+    | Failure of string
+    | Timeout of string
+
+type MLHealthResp = { status: string; device: string }
+
+
+type MLService = {
+    health: unit -> Async<Result<MLHealthResp, InfraError>>
+    inference: InferenceRequest -> Async<Result<InferenceResponse, InfraError>>
+}

server/src/Api/Business/Persistence.fs

@@ -0,0 +1,20 @@
+module Application.Persistence
+
+open Domain.Types
+
+type PersistenceError =
+    | DB of string
+    | ImageNotFound of Id
+    | InferenceFailed of Id
+    | GCS of string
+
+type ImageInfoRepo = {
+    register: Image -> Async<Result<Image, PersistenceError>>
+    retrieve: Id -> Async<Result<Image, PersistenceError>>
+}
+
+type RawImageRepo = {
+    upload:
+        Base64 -> Async<Result<Google.Apis.Storage.v1.Data.Object, PersistenceError>>
+    downloadBase64: Id -> Async<Result<Base64, PersistenceError>>
+}

server/src/Api/Domain.fs

@@ -0,0 +1,27 @@
+module Domain
+
+module Types =
+
+    type Id = string
+
+    type Base64 = string
+
+    type Image = { id: Id; base64: Base64; url: string }
+
+    type InferenceRequest = { prompt: string; image_base64: Base64 }
+
+    type InferenceResponse = { id: Id; image: Image }
+
+    type DomainError =
+        /// 既に推論済みの画像を再度推論したら
+        | AlreadyInferred of Id
+
+    type Command =
+        | GetImage of Id
+        | SaveImage of Base64
+        | Inference of InferenceRequest
+
+    type Event =
+        | ImageRetrieved of Image
+        | ImageSaved of Image
+        | InferenceCompleted of InferenceResponse

server/src/Api/Program.fs

@@ -1,15 +1,28 @@
-open System
-open Microsoft.AspNetCore.Builder
-open Microsoft.Extensions.Hosting
+open Falco
+open Falco.Routing
+open Falco.HostBuilder
 
 [<EntryPoint>]
 let main args =
-    let builder = WebApplication.CreateBuilder(args)
-    let app = builder.Build()
+    webHost [||] {
+        endpoints [
+            get "/health" (Response.ofJson {| env = "local" |})
+            get "/health/ml" (Response.ofJson {| env = "local" |})
 
-    app.MapGet("/", Func<string>(fun () -> "Hello World!"))
-    |> ignore
+            get "/image/{id}" (Response.ofJson {| id = "1"; img = "base64" |})
 
-    app.Run()
+            (*
+                input: { parent_image: base64 }
+            *)
+            post
+                "/inference"
+                (Response.ofJson {|
+                    parent_id = "1"
+                    child_id = "1"
+                    img = "base64"
+                |})
+
+        ]
+    }
 
     0 // Exit code

server/src/Api/Repositories/Database.fs

@@ -0,0 +1,76 @@
+module Repository.Database
+
+open FsToolkit.ErrorHandling
+
+open System.Data
+open Dapper.FSharp.MySQL
+open MySql.Data.MySqlClient
+open Domain.Types
+open Application.Persistence
+
+OptionTypes.register ()
+
+type DBEnv = {
+    IS_DEV: bool
+    DB_HOST: string
+    DB_USER: string
+    DB_PASSWORD: string
+    DB_DATABASE: string
+}
+
+let conn (env: DBEnv) : IDbConnection =
+    let connStr =
+        if env.IS_DEV then
+            $"Server={env.DB_HOST};Port=3306;Database={env.DB_DATABASE};user={env.DB_USER};password={env.DB_PASSWORD}"
+        else
+            $"Server={env.DB_HOST};Port=3306;Database={env.DB_DATABASE};user={env.DB_USER};password={env.DB_PASSWORD};SslMode=VerifyFull"
+
+    new MySqlConnection(connStr)
+
+(*
+    複雑なクエリはこのように叩く
+    let sql = SELECT * FROM Morphoto WHERE morphoto_id = @morphoto_id    
+    let conn = conn env
+
+    conn.QueryAsync<Morphoto>(
+        sql,
+        {| morphoto_id = morphoto_id |}
+    )
+    |> Task.map (Seq.toArray >> Ok) 
+*)
+
+
+let morphotoRepo env : Application.Persistence.ImageInfoRepo = {
+    register =
+        fun morphoto ->
+            let conn = conn env
+
+            insert {
+                into table<Image>
+                value morphoto
+            }
+            |> conn.InsertAsync
+            |> Task.map (fun _ -> morphoto)
+            |> AsyncResult.ofTask
+            |> AsyncResult.mapError (fun e -> DB e.Message)
+
+    retrieve =
+        fun parent_id ->
+            let conn = conn env
+
+            select {
+                for m in table<Image> do
+                    where (m.id = parent_id)
+                    take 1
+            }
+            |> conn.SelectAsync<Image>
+            |> Task.map (
+                Seq.tryHead
+                >> function
+                    | Some s -> Ok s
+                    | None -> Error(DB "not found")
+            )
+            |> AsyncResult.ofTask
+            |> AsyncResult.mapError (fun e -> DB e.Message)
+            |> Async.map (Result.bind id)
+}

server/src/Api/Repositories/GCS.fs

@@ -0,0 +1,68 @@
+module Repository.GCS
+
+open Domain.Types
+open Google.Cloud.Storage.V1
+open Google.Apis.Auth.OAuth2
+open System.Net.Http
+open System
+open System.IO
+open System.Text.RegularExpressions
+open Application.Persistence
+
+type GCS_ENV = {
+    GCP_CREDENTIALS: string
+    GCP_BUCKET_NAME: string
+    GCS_URL: string
+}
+
+let private downloadImageAndConvertToBase64 (imageUrl: string) =
+    use httpClient = new HttpClient()
+    let imageBytes = httpClient.GetByteArrayAsync(imageUrl)
+    imageBytes.Wait()
+    let base64String: Base64 = Convert.ToBase64String(imageBytes.Result)
+    base64String
+
+let getBase64FromGCS (fileName: string) (env: GCS_ENV) =
+    async {
+        try
+            let url = $"{env.GCS_URL}/{fileName}"
+            let base64String = downloadImageAndConvertToBase64 url
+            return Ok base64String
+        with e ->
+            return Error(PersistenceError.GCS e.Message)
+    }
+
+let uploadFile (base64: string) (env: GCS_ENV) =
+    async {
+        try
+            let cred = GoogleCredential.FromJson(env.GCP_CREDENTIALS)
+            let storage = StorageClient.Create(cred)
+
+            let regex = Regex("data:image/(.*);base64,(.*)")
+
+            let base64 =
+                if regex.IsMatch base64 then
+                    regex.Match base64 |> fun m -> m.Groups.[2].Value
+                else
+                    base64
+
+            use stream = new MemoryStream(Convert.FromBase64String(base64))
+
+            let r =
+                storage.UploadObject(
+                    env.GCP_BUCKET_NAME,
+                    Guid.NewGuid().ToString(),
+                    "image/png",
+                    stream
+                )
+
+            return Ok r
+        with e ->
+            return Error(PersistenceError.GCS e.Message)
+    }
+
+
+let gcsStore env : Application.Persistence.RawImageRepo = {
+    downloadBase64 = fun (fileName: string) -> getBase64FromGCS fileName env
+    upload = fun base64 -> uploadFile base64 env
+}

server/src/Api/Repositories/ML.fs

@@ -0,0 +1,45 @@
+module Repository.ML
+
+open Domain
+open FsHttp
+open System.Net
+open Application.Infra
+open Domain.Types
+
+type MLEnv = { ML_URL: string }
+
+type MLRequest = {
+    prompt: string
+    image: string
+    strength: float
+    is_mock: bool option
+}
+
+let inference (request: InferenceRequest) (env: MLEnv) =
+    http {
+        POST $"{env.ML_URL}/inference"
+        body
+        jsonSerialize request
+    }
+    |> Request.sendAsync
+    |> Async.map (fun resp ->
+        if resp.statusCode = HttpStatusCode.OK then
+            resp |> Response.deserializeJson<InferenceResponse> |> Ok
+        else
+            Error(Failure "ML Server Error"))
+
+let mlRepo env : Application.Infra.MLService = {
+    inference = fun request -> inference request env
+    health =
+        fun () ->
+            http {
+                GET $"{env.ML_URL}/health"
+                body
+            }
+            |> Request.sendAsync
+            |> Async.map (fun resp ->
+                if resp.statusCode = HttpStatusCode.OK then
+                    resp |> Response.deserializeJson<MLHealthResp> |> Ok
+                else
+                    Error(Failure "ML Server Error"))
+}